01 工作表
批量工作簿、表的合并
选择的单或多个工作簿，依次将每个工作簿内的单个或多个工作表合并到名为“汇总表”的工作表内，首列显示来源工作簿&工作表名。
对基础知识八的第二小节🔗《|02 合并跨工作簿的工作表》的重新编写：
- 1、增加一个"汇总表"是否存在的、"预判错误，提前处理"的方式；
- 2、增加一个"未选择任何工作簿"的错误处理方式；
- 3、增加了"禁止屏幕刷新和弹窗警告"的代码优化方式。
以上的处理，让程序增加健壮且运行更有效率！
运行视频：
源码下载：
描述：
系统导出连续的、行标题字段相同的信息，如何快速汇总？
样本示例：
结果示例：
需求分析：
- 1、当前表可能不存在汇总结果要保存的表，增加一个判断；
- 2、用户可能不会选择任何工作簿，增加判断；
- 3、首列要写入来源的工作簿、表，复制粘贴时要从B列开始；
- 4、被操作的工作簿对象的数量不确定，为提升效率禁用屏幕刷新。
VBA实现过程：
- 1、Application.ScreenUpdating=False，Application.DisplayAlerts=False禁用；
- 2、ThisWorkbook.Sheets.Add增加表，命名"汇总表"，配合On Error Resume Next的错误处理方式，判断是否已经存在该表；
- 3、Application.GetOpenFilename()和用户交互，让用户选择需要合并的工作簿，增加一个If VBA.TypeName(FileToOpen) = "Boolean"的判断，如果没有选择工作簿，没有可供操作的对象，则终止程序；
- 4、主程序逻辑实现过程
- ①循环被选择的工作簿：打开工作簿，嵌套一个工作表的循环，
- ②工作表的循环中：复制数据表+粘贴到目标表的B列，
- ③工作表循环中：获取复制数据表的行数，和目标表的使用使用的行数，粘贴位置往下一行延续，避免数据覆盖，
- ④工作表循环中：工作簿.name+工作表.name，填充到目标表的首列，获取数据来源路径；
- 5、汇总表完成！
- 6、Application.ScreenUpdating=True， Application.DisplayAlerts=True恢复。
示例代码
复制成功!
1
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 = True
End Sub
请开发者喝杯咖啡！