求Excel VBA代码：合并指定工作表至按钮所在工作簿

看起来你已经有了初步的思路，我帮你完善并修正代码，解决遍历工作簿、复制指定工作表的问题，同时避开常见的坑（比如复制自身工作簿的表、变量声明不规范、工作表不存在导致报错等）。

先看你给出的代码片段：

Sub workbookFetcher() 
    Dim book As Workbook, sheet, wsNew, wsCurr As Worksheet 
    Set wsCurr = ActiveSheet 
    For Each book In Workbooks 
    For Each sheet In ...

完整修正后的代码 #

Sub workbookFetcher()
    ' 规范声明所有变量，避免隐式Variant类型带来的潜在问题
    Dim book As Workbook
    Dim targetSheet As Worksheet
    Dim targetWorkbook As Workbook
    
    ' 绑定按钮所在的工作簿，彻底避免ActiveSheet切换导致的目标错误
    Set targetWorkbook = ThisWorkbook
    
    ' 遍历所有已打开的工作簿
    For Each book In Workbooks
        ' 跳过自身工作簿，防止重复复制
        If book.Name <> targetWorkbook.Name Then
            On Error Resume Next ' 临时启用错误处理，快速检查工作表是否存在
            Set targetSheet = book.Worksheets("specificsheetname")
            On Error GoTo 0 ' 恢复默认错误处理逻辑
            
            ' 如果找到指定名称的工作表
            If Not targetSheet Is Nothing Then
                ' 将工作表复制到目标工作簿的最后位置
                targetSheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
                
                ' 可选：给复制后的工作表重命名，避免默认的(2)(3)后缀，方便区分来源
                ' targetWorkbook.Sheets(targetWorkbook.Sheets.Count).Name = book.Name & "_specificsheet"
                
                ' 重置变量，避免下一次循环误判
                Set targetSheet = Nothing
            End If
        End If
    Next book
    
    MsgBox "合并完成！共添加" & (targetWorkbook.Sheets.Count - 1) & "个工作表", vbInformation
End Sub

关键细节说明 #

• 变量规范声明：你的原代码里sheet、wsNew都是隐式的Variant类型，明确指定Worksheet类型可以减少运行时错误概率。
• 绑定目标工作簿：用ThisWorkbook代替ActiveSheet，确保始终操作按钮所在的工作簿，不会因为切换窗口导致目标错乱。
• 排除自身工作簿：通过book.Name <> targetWorkbook.Name跳过当前宏所在的工作簿，防止无意义的重复复制。
• 检查工作表存在性：用错误处理快速判断目标工作表是否存在，避免因某个工作簿缺少指定表而导致代码中断。
• 复制位置控制：Copy After:=...把表复制到目标工作簿的最后，保持合并后的表顺序清晰。

使用方法 #

1. 打开空白工作簿，按Alt+F11打开VBA编辑器；
2. 插入模块，把上述代码粘贴进去；
3. 返回Excel界面，添加表单控件按钮，指定宏为workbookFetcher；
4. 打开所有需要合并的工作簿（确保它们都包含名为specificsheetname的工作表）；
5. 点击按钮，等待合并完成即可。

内容的提问来源于stack exchange，提问作者nh3