
假设你有几十个甚至几百个工作簿,每个工作簿里有若干表(少则一个,多则十几个工作表,每个表的数据结构相同,数据记录条数不等),现在你需要把这些工作簿里的每个工作表里的数据,复制粘贴到一个新工作簿的一个空白表里。
多个工作簿具有相同的表格结构。
有300个工作簿,每个工作簿大概3-6个工作表不等,数据记录都是500行。
这些工作簿存储在某盘文件夹“多工作簿多表超级汇集”下的子文件夹“明细表”里。
下面是其中一个工作簿里的一个工作表数据
汇总表就存在“多工作簿多表超级汇集”这个文件夹下,见下图
打开工作簿“汇总表.xlsxm” (带VBA程序的excel工作簿应该保存为这种格式)
先学习第一种方法,在“总表”这个工作表里设置好表头,调整好列宽和格式,绘制好圆角矩形作为宏代码的执行按钮。
按ALT+F11,插入,模块,把以下代码复制到模块1里
Sub 汇总不带表名()
Dim wb, mypath, myfile, sh, zong
t = Timer '开始时间
Set zong = Sheets("总表")
zong.UsedRange.Offset(1, 0).ClearContents
mypath = ThisWorkbook.Path & "\明细表\"
myfile = Dir(mypath & "*.xlsx")
Do While myfile <> ""
Set wb = GetObject(mypath & myfile)
For Each sh In wb.Worksheets
On Error Resume Next
With sh
.UsedRange.Offset(1, 0).Copy zong.Cells(Range("a" & Rows.Count).End(xlUp).Row + 1, 1)
End With
Next
wb.Close False
myfile = Dir
Loop
Set wb = Nothing
MsgBox "数据合并用时:" & Format(Timer - t, "#0.000") & " 秒", , "温馨提示:汇总完成!"
End Sub
关闭vba编辑窗口。右键单击按钮,指定宏,选择“汇总不带表名”,确定。
单击“提取”按钮,程序开始执行,大约10秒时间汇总完毕。
时间长短取决于电脑内存以及汇总的工作表的数量。
另外,也可以通过安装Power Query插件进行快速合并。此处不再做介绍。
