以下是一个合并多个Excel工作簿中的工作表到一个工作簿中的VBA程序。将此代码复制到一个新的VBA模块中,然后运行它。

Sub MergeExcelFiles()
    Dim Path As String, Filename As String, Sheet As Worksheet, SheetName As String
    Dim NewWorkbook As Workbook, OldWorkbook As Workbook
    
    '设置当前工作目录以合并工作簿
    Path = 'C:\Users\JohnDoe\Documents\MergeFiles\'
    Filename = Dir(Path & '*.xls*')
    
    '创建新工作簿以合并所有工作表
    Set NewWorkbook = Workbooks.Add
    NewWorkbook.SaveAs Filename:=Path & 'MergedFiles.xlsx'
    
    '遍历所有工作簿中的所有工作表
    Do While Filename <> ''
        Set OldWorkbook = Workbooks.Open(Path & Filename)
        For Each Sheet In OldWorkbook.Sheets
            Sheet.Copy After:=NewWorkbook.Sheets(NewWorkbook.Sheets.Count)
            SheetName = Sheet.Name
            NewWorkbook.Sheets(NewWorkbook.Sheets.Count).Name = Filename & ' - ' & SheetName
        Next Sheet
        OldWorkbook.Close SaveChanges:=False
        Filename = Dir()
    Loop
    
    '删除新工作簿中的第一个空白工作表
    NewWorkbook.Sheets(1).Delete
    
    '保存新工作簿并关闭
    NewWorkbook.Save
    NewWorkbook.Close
    
    '提醒用户合并完成
    MsgBox '合并完成!'
End Sub

说明:

  • 将代码中的 'C:\Users\JohnDoe\Documents\MergeFiles' 替换为你实际的 Excel 文件路径。
  • 代码将遍历指定路径下的所有 Excel 文件,并将每个文件的所有工作表复制到新工作簿中。
  • 新工作簿名为 'MergedFiles.xlsx',存储在与源文件相同的路径下。
  • 每个工作表名称将被修改为包含其原始文件名和工作表名称。
  • 新工作簿的第一个空白工作表将被删除。
  • 最后,新工作簿将被保存并关闭。

此代码提供了一种简单的方法来合并多个 Excel 工作簿中的工作表。你可以根据需要修改代码以适应不同的需求。

VBA代码:合并多个Excel工作簿中的工作表

原文地址: https://www.cveoy.top/t/topic/n4KX 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录