N个EXCEL工作簿如何快速合并

N个EXCEL工作簿如何快速合并

假设你有几十个甚至几百个工作簿,每个工作簿里有若干表(少则一个,多则十几个工作表,每个表的数据结构相同,数据记录条数不等),现在你需要把这些工作簿里的每个工作表里的数据,复制粘贴到一个新工作簿的一个空白表里。

多个工作簿具有相同的表格结构。

有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插件进行快速合并。此处不再做介绍。