Sub CombineSheets() Dim ws As Worksheet Dim summarySheet As Worksheet Dim lastRow As Long Dim pasteRow As Long ' 创建一个新的工作表 Set summarySheet = ThisWorkbook.Sheets.Add summarySheet.Name = "CombinedData" pasteRow = 1 ' 遍历所有工作表 For Each ws In ThisWorkbook.Sheets If ws.Name <> "CombinedData" Then lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 复制数据 ws.Rows("1:" & lastRow).Copy summarySheet.Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValues ' 更新粘贴行 pasteRow = summarySheet.Cells(summarySheet.Rows.Count, 1).End(xlUp).Row + 1 End If Next ws Application.CutCopyMode = False MsgBox "数据已成功合并到 CombinedData 工作表中！" End Sub
方法一：使用 Power Query（推荐） 打开 Power Query： 点击 数据 选项卡。 选择 获取数据 > 从其他来源 > 从工作簿。 选择文件： 在弹出的对话框中选择当前的 Excel 文件。 加载所有工作表： 选择所有需要合并的工作表，点击 加载。 合并表格： 点击 追加查询。 选择要合并的所有表格，确认即可。 加载到新工作表： 完成后，点击 关闭并加载，将合并后的数据加载到一个新工作表中。
方法二：使用 VBA 宏 如果表格格式一致，可以用以下 VBA 代码快速合并： 打开开发工具： 如果 开发工具 选项卡未显示： 点击 文件 > 选项 > 自定义功能区，勾选 开发工具。 插入宏： 点击 开发工具 > Visual Basic。 插入新模块（右键单击 VBAProject > 插入 > 模块）。 粘贴代码： 将以下代码粘贴到模块中：
Sub CombineSheets() Dim ws As Worksheet Dim summarySheet As Worksheet Dim lastRow As Long Dim pasteRow As Long ' 创建一个新的工作表 Set summarySheet = ThisWorkbook.Sheets.Add summarySheet.Name = "CombinedData" pasteRow = 1 ' 遍历所有工作表 For Each ws In ThisWorkbook.Sheets If ws.Name <> "CombinedData" Then lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 复制数据 ws.Rows("1:" & lastRow).Copy summarySheet.Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValues ' 更新粘贴行 pasteRow = summarySheet.Cells(summarySheet.Rows.Count, 1).End(xlUp).Row + 1 End If Next ws Application.CutCopyMode = False MsgBox "数据已成功合并到 CombinedData 工作表中！" End Sub