A、B、C这三个工作簿的数据都在sheet1，表头一样
Sub MergeWorkbooks()Dim FolderPath As StringDim FileName As StringDim wb As WorkbookDim ws As WorksheetDim mainWb As WorkbookDim mainWs As WorksheetDim lastRow As LongDim lastcol As LongDim pasteRange As Range' 主工作簿设置为当前工作簿Set mainWb = ThisWorkbookSet mainWs = mainWb.Sheets(1) ' 假设数据合并到第一张表中mainWs.Cells.Clear' 获取文件夹路径（你可以根据需求修改文件夹路径）'FolderPath = "D:\VBA\hebin\" ' 更改为你实际存储文件的路径FolderPath = ThisWorkbook.Path & "\"' 确保路径以反斜杠结尾If Right(FolderPath, 1) <> "\" ThenFolderPath = FolderPath & "\"End If' 获取第一个Excel文件FileName = Dir(FolderPath & "*.xlsx")' 如果找不到任何文件，则提示并退出If FileName = "" ThenMsgBox "未找到任何Excel文件，请检查路径或文件格式。"Exit SubEnd If' 循环所有Excel文件Do While FileName <> mainWb.Name' 打开工作簿On Error Resume NextSet wb = Workbooks.Open(FolderPath & FileName)If Err.Number <> 0 ThenMsgBox "无法打开文件：" & FileNameErr.ClearExit SubEnd IfOn Error GoTo 0' 假设数据在每个工作簿的第一张表中，找到最后一行并复制数据Set ws = wb.Sheets(1)lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Rowlastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Columnws.Cells(1, 1).Resize(1, lastcol).Copy Destination:=mainWs.Cells(1, 1)' 查找主工作簿中当前的最后一行If Application.WorksheetFunction.CountA(mainWs.Cells) > 0 ThenSet pasteRange = mainWs.Cells(mainWs.Rows.Count, 1).End(xlUp).Offset(1, 0)ElseSet pasteRange = mainWs.Cells(1, 1)End If' 复制工作簿中的数据并粘贴到主工作簿'ws.Range("A1:" & ws.Cells(lastcol, lastRow).Address).Copyws.Range("A2:E" & lastRow).CopymainWs.Paste Destination:=pasteRange' 关闭工作簿（不保存）wb.Close False' 获取下一个文件FileName = DirLoopWith mainWs.Cells.HorizontalAlignment = xlCenter '设置水平居中.VerticalAlignment = xlCenter '设置垂直居中.Font.Size = 14End With' 完成后提示MsgBox "所有工作簿已成功合并！"
End Sub循环获取文件夹中的每个文件
Sub ListFiles()Dim fileName As String' 第一次调用 Dir 并传入路径，获取第一个文件fileName = Dir(ThisWorkbook.Path & "/")' 使用循环，逐步获取下一个文件Do While fileName <> ""MsgBox fileName ' 显示文件名fileName = Dir ' 不带参数，获取下一个文件Loop
End Sub
’如果想要获取路径，就Thisworkbook.Path & "/" & filename 
