这个代码应该也适用于一些表头相同的工作表的汇总，只需要修改想要遍历的表，适用于处理大量表头相同的表的合并

这里的汇总合并表 total 是我事先创建的，我觉得比用vba代码创建要容易一下，如果不事先创建汇总表就用下面的代码，在表的部分会报错(在我的主页Excel:vba实现拆分单元格成一字一单元格里面说过这一点，并写有代码)

Sub total()Dim totalws As WorksheetDim ws As WorksheetDim colindex As IntegerDim lastrow As LongDim lastcol As LongDim wsname As VariantDim currentRow As Long' 设定目标工作表Set totalws = ThisWorkbook.Worksheets("total")'清空表，防止还没合并的时候表里面有数据以及运行一次覆盖就原有数据totalws.Cells.Clear' 初始化totalws行索引，意思是从totalws的第一行开始粘贴currentRow = 1' 遍历需要合并的工作表For Each wsname In Array("六1", "六2", "六3", "六4")'通过工作表的名称获取工作表Set ws = Worksheets(wsname)' 查找每张表的最后一行和最后一列lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Rowlastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column' 只在第一次循环时复制表头If currentRow = 1 Then'将表头复制到汇总表的第一行ws.Cells(1, 1).Resize(1, lastcol).Copy Destination:=totalws.Cells(currentRow, 1)'行数加一，以便后续数据的粘贴到totalwscurrentRow = currentRow + 1End If' 复制数据，跳过表头ws.Cells(2, 1).Resize(lastrow - 1, lastcol).Copy Destination:=totalws.Cells(currentRow, 1)'复制完数据之后，totalws表最后一行的行数加一，以便后续数据的粘贴复制currentRow = totalws.Cells(totalws.Rows.Count, 1).End(xlUp).Row + 1Next wsnameMsgBox "数据合并完成！"
End Sub