昨天发过一种vba方法，把一个工作簿里上百个分表复制粘贴到当前工作簿的总表里，
只要几秒钟。
见这篇文章：
100个工作表，数据瞬间汇集到一个总表里，你复制粘贴1小时，我只需要1秒！
今天给大家介绍另外一种绝招！神技！彪悍的人生无需解释！
假设你有几十个甚至几百个工作簿，每个工作簿里有若干表（少则一个，多则十几个工作表，每个表的数据结构相同，数据记录条数不等），现在你需要把这些工作簿里的每个工作表里的数据，复制粘贴到一个新工作簿的一个空白表里。
如果你有300个工作簿，每个工作簿里有7个工作表。假设这2000多个工作表里的数据记录（记录条数总数最多不能超过104万行，因为xlsx格式的单表最多行数是1048576行）都被复制粘贴到一个新工作簿里的某个空白表里，如果纯粹手工复制粘贴，操作熟练快速，中间不出任何差错，我毛估时间至少得10-15个小时。
也就是说你可能得机械地复制粘贴1-2个工作日的上班时间，中间不能有任何错误，否则可能意味着要检查甚至重新复制粘贴。
想必，有很多朋友这么干过。这么做过的人，都明白，枯躁乏味，苦不堪言，但却又无能为力！
下面是案例背景。
有300个工作簿，每个工作簿大概3-6个工作表不等，数据记录都是500行。
这些工作簿存储在某盘文件夹“多工作簿多表超级汇集”下的子文件夹“明细表”里
下面是其中一个工作簿里的一个工作表数据，记录数有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编辑窗口。右键单击按钮，指定宏，选择“汇总不带表名”，确定。
单击“提取”按钮，程序开始执行，大约6-7秒时间汇总完毕。时间长短取决于电脑内存以及汇总的工作表的数量（这里为了简化起见，只保留了7个工作簿，所以时间比较短，只有几秒钟）。
“总表”里的结果，是通过代码把各个表里的数据直接粘贴过来，没有考虑每个工作表的表名。
接下来再介绍一种vba写法，很多写法和上一种类似，就是加了增加表名作为列字段。
Sub 汇集带表名()
Dim wb, hui, mypath, myfile, sh, myirow, newirow
t = Timer '开始时间
Set hui = Sheets("汇集")
hui.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
myirow = hui.Range("B" & Rows.Count).End(xlUp).Row + 1
.UsedRange.Offset(1, 0).Copy hui.Cells(myirow, 2)
newirow = hui.Range("B" & Rows.Count).End(xlUp).Row
hui.Range("A" & myirow & ":A" & newirow) = sh.Name
End With
Next
wb.Close False
myfile = Dir
Loop
Set wb = Nothing
MsgBox "数据合并用时：" & Format(Timer - t, "#0.000") & " 秒", , "则见温馨提示：汇总完成！每一天都是美妙的！"
End Sub
其他细节略。
点击“超级汇”按钮，大概3分钟不到执行完毕。
执行时间总共160多秒。因为这里测试用到的要提取数据的工作簿个数是300个（工作表总数大概2000个）。
最后提取的记录数右789000行。
复制粘贴2000个工作表到一个总表里来，不过3分钟！
提醒下，是从300个工作簿里，复制粘贴到“汇集”表里的！
提醒下，“汇集”总表里，还增加一列城市字段，其实就是2000个工作表的表名！
如果全部靠人工来复制粘贴，那么15个小时-20个小时是跑不掉的！
而且做这个工作的人，简直痛不欲生，无语凝噎，估计双手都得抽筋！
但是，我们这段代码，只需要3分钟！
只需要180秒！
只需要180秒！
只需要180秒！
再不学习，还想又快又好，还想升职加薪，简直痴人说梦！
更多惊世绝技！倘若您学到一个技巧，解决了一个长久以来让您纠结的问题，就值回票价！
但我担保，能解决您上百个甚至上千个这样的问题！
尽在《Excel+PPT+Word小白变高手[436节]》
洞悉Excel底层逻辑的框架完整
案例全网最实战的课程
你开不开始，都已经晚了很久，因为很多人已经学了18个月了
最后，推荐一个课程，收费的！418元，永久有效，一网打尽Excel、PPT和Word的职场牛擦技能！目前更新了436节，还有70多节在录制中，力争更新到518节！平均每节不足1元钱（我不知道哪里还能找到如此低价高质的课程，你翻遍互联网也没有，找到告诉你，我立即谢谢你3000元）。
只要您坚持学6个月到12个月，我一定确保您成为这个领域里的高手，顶尖高手不能确保，但睥睨周围同事横扫方圆99%的职场白骨精，我还是能确保的！
那么这套王牌的课程就是，
Excel+PPT修炼营Office小白变高手
http://study.163.com/course/courseMain.htm?courseId=1106004
点击阅读原文，打开购买链接，一次购买课程，享受终生辅导，李则见老师大部分情况下都直接回答你关于课程本身的所有问题，我微信号excelpptpeixun
