Sub CombineWorkbooks()

Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim myWorkbook As Workbook
Dim targetWorkbook As Workbook

' 设置要合并的工作簿所在的文件夹路径
myPath = 'C:\Users\User\Documents\TestFolder\'

' 设置要合并的工作簿的文件扩展名
myExtension = '*.xlsx'

' 创建一个新的工作簿来存储合并后的数据
Set targetWorkbook = Workbooks.Add

' 循环遍历文件夹中所有具有指定扩展名的文件
myFile = Dir(myPath & myExtension)
Do While myFile <> ''
    
    ' 依次打开每个工作簿
    Set myWorkbook = Workbooks.Open(myPath & myFile)
    
    ' 将每个工作簿中的所有工作表数据复制到目标工作簿
    For Each ws In myWorkbook.Worksheets
        ws.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
    Next ws
    
    ' 关闭工作簿,不保存更改
    myWorkbook.Close SaveChanges:=False
    
    ' 获取下一个文件名
    myFile = Dir
Loop

' 以新名称保存目标工作簿
targetWorkbook.SaveAs Filename:=myPath & 'CombinedWorkbook.xlsx', FileFormat:=xlOpenXMLWorkbook

' 关闭目标工作簿
targetWorkbook.Close SaveChanges:=True

' 显示消息框,指示进程已完成
MsgBox 'The workbooks have been combined.'

End Sub


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

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