如何修改Excel VBA宏将文件夹工作簿合并到新建工作簿

你的核心问题是复制工作表时指向了ThisWorkbook（运行宏的原工作簿），而非新建的目标工作簿。另外，直接通过文件名引用工作簿容易出错，建议用对象变量管理新建工作簿，避免依赖Activate操作（这是VBA里的常见坑）。

修改后的完整代码 #

Sub MergeWorkbooks()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' 声明对象变量，引用新建的合并工作簿
    Dim wbMerged As Workbook
    ' 新建工作簿并赋值给变量
    Set wbMerged = Workbooks.Add
    ' 保存新建工作簿
    wbMerged.SaveAs Filename:="C:\你的路径\Merged Files.xlsx"
    
    Dim FolderPath As String
    Dim Filename As String
    Dim Sheet As Worksheet
    Dim wbSource As Workbook
    
    FolderPath = "<Folder destination>"
    ' 确保文件夹路径末尾带反斜杠，避免拼接错误
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    Filename = Dir(FolderPath & "*.xls*")
    
    Do While Filename <> ""
        ' 打开源文件并赋值给变量
        Set wbSource = Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
        For Each Sheet In wbSource.Sheets
            ' 将源工作表复制到新建工作簿的最后
            Sheet.Copy After:=wbMerged.Sheets(wbMerged.Sheets.Count)
        Next Sheet
        ' 关闭源文件，不保存
        wbSource.Close SaveChanges:=False
        Filename = Dir()
    Loop
    
    ' 可选：删除新建工作簿默认的空白工作表
    If wbMerged.Sheets.Count > 1 Then
        Application.DisplayAlerts = False
        wbMerged.Sheets(1).Delete
        Application.DisplayAlerts = True
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

关键修改点说明 #

• 用对象变量替代Activate：声明wbMerged变量直接绑定新建工作簿，后续操作全通过变量完成，避免因激活状态变化导致的错误。
• 修正复制目标：把Sheet.Copy After:=ThisWorkbook.Sheets(1)改成Sheet.Copy After:=wbMerged.Sheets(wbMerged.Sheets.Count)，确保工作表复制到新建工作簿中（用Sheets.Count是把新表放到最后，可按需调整位置）。
• 源文件也用对象变量：wbSource引用打开的源工作簿，比用文件名Workbooks(Filename)更可靠，避免文件名含特殊字符时出错。
• 路径补全处理：自动给文件夹路径补全反斜杠，防止拼接文件名时出现格式错误。
• 清理默认空白表：新建工作簿自带的空白工作表可按需删除，让合并结果更整洁。

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