Sub 合并工作簿() Dim wb As Workbook Dim wsMerged As Worksheet Dim rng As Range Dim lastRow As Long Dim lastCol As Long Dim i As Long ' 创建一个新的工作簿用于存放合并后的数据 Set wb = Workbooks.Add wb.SaveAs "合并后的工作簿.xlsx" '保存新的工作簿 Set wsMerged = wb.Worksheets(1) wsMerged.Name = "合并后的工作表" ' 遍历所有工作簿 For Each wb In Application.Workbooks ' 跳过新创建的工作簿 If wb.Name <> wb.Path & "\合并后的工作簿.xlsx" Then ' 遍历当前工作簿的所有工作表 For Each ws In wb.Worksheets ' 获取当前工作表的最后一行和最后一列 lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' 复制当前工作表的数据到新工作簿的新工作表 Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)) rng.Copy Destination:=wsMerged.Cells(wsMerged.Cells(wsMerged.Rows.Count, 1).End(xlUp).Row + 1, 1) Next ws End If Next wb ' 提示合并完成 MsgBox "工作簿合并完成!" End Sub
求大佬解答并修改代码