1、右键工作表,点查看代码

2、插入模块,在模块中,复制以下代码,单击运行亦或增加宏按钮Sub 合并() '———————斑从腧笮————————————————————————————————— '自定义各数据类型 Dim FileToOpen As Variant Dim i, RW, CL, RW_1, CL_1 As Long Dim sht As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False '判断工作簿中是否包含《汇总表》,如过不存在就新增一个 On Error Resume Next ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ActiveSheet.Name = "汇总表" If Err.Number > 0 Then ActiveSheet.Delete On Error GoTo 0 '多选或单选要合并的工作薄/表,如果没有选择任何文件则退出 FileToOpen = Application.GetOpenFilename("Excel文件,*.xl*", , "请选择要合并的多个工作簿/表", , True) If VBA.TypeName(FileToOpen) = "Boolean" Then MsgBox "没有选择文件": Exit Sub End If '合并过程,遍历选中的每个工作薄、工作表,在首列增加来源的工作薄+工作表名 On Error Resume Next For i = 1 To UBound(FileToOpen) Workbooks.Open Filename:=FileToOpen(i) For Each sht In ActiveWorkbook.Sheets sht.Activate RW_1 = sht.UsedRange.Rows.Count CL_1 = sht.UsedRange.Columns.Count If RW_1 + CL_1 > 0 Then RW = ThisWorkbook.Sheets("汇总表").UsedRange.Rows.Count If RW > 1 Then ActiveSheet.Cells(1, 1).Resize(RW_1, CL_1).Copy _ Destination:=ThisWorkbook.Sheets("汇总表").Cells(RW + 1, 2) ThisWorkbook.Sheets("汇总表").Cells(RW + 1, 1) = "来源表" ThisWorkbook.Sheets("汇总表").Cells(RW + 2, 1).Resize(RW_1 - 1, 1) = ActiveWorkbook.Name & "-" & sht.Name Else ActiveSheet.Cells(1, 1).Resize(RW_1, CL_1).Copy _ Destination:=ThisWorkbook.Sheets("汇总表").Cells(1, 2) ThisWorkbook.Sheets("汇总表").Cells(1, 1) = "来源表" ThisWorkbook.Sheets("汇总表").Cells(2, 1).Resize(RW_1 - 1, 1) = ActiveWorkbook.Name & "-" & sht.Name End If End If Next sht ActiveWorkbook.Close Next i On Error GoTo 0 MsgBox "汇总表完成" Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub

3、选中需要合并的工作薄(一个或多个),之后单击“打开”

4、合并完成后的结果,出现在汇总表里首列为合并的工作薄名+表名
