VBA宏自动合并EXCEL源文件夹工作簿中的表到一个新工作簿的工作表

Sub 合并多个工作簿的工作表到新工作簿的单个工作表()

Dim FolderPath As String

Dim MyFile As String

Dim SourceWorkbook As Workbook

Dim TargetWorkbook As Workbook

Dim TargetWorksheet As Worksheet

' 弹出文件夹选择对话框，让用户选择文件夹

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "请选择源工作簿所在的文件夹"

.Show

If .SelectedItems.Count = 0 Then Exit Sub ' 如果用户没有选择文件夹，则退出宏

FolderPath = .SelectedItems(1) & "\"

End With

' 创建一个新的工作簿用于存放合并后的工作表

Set TargetWorkbook = Workbooks.Add

Set TargetWorksheet = TargetWorkbook.Sheets(1)

TargetWorksheet.Name = "合并后的工作表"

Application.ScreenUpdating = False

Application.DisplayAlerts = False

' 获取文件夹中的第一个Excel文件

MyFile = Dir(FolderPath & "*.xls*")

Dim LastRow As Long

' 循环遍历文件夹中的所有Excel文件

Do While MyFile <> ""

' 打开当前文件

Set SourceWorkbook = Workbooks.Open(FolderPath & MyFile)

' 确定合并后工作表的最后一行

LastRow = TargetWorksheet.Cells(TargetWorksheet.Rows.Count, 1).End(xlUp).Row + 1

' 将当前工作簿的工作表内容复制到合并后的工作表中

SourceWorkbook.Sheets(1).UsedRange.Copy Destination:=TargetWorksheet.Cells(LastRow, 1)

' 立即关闭当前工作簿，不保存更改

SourceWorkbook.Close SaveChanges:=False

' 获取下一个文件

MyFile = Dir

Loop

End Sub