【原】“这么快，10多个工作簿，话才说完，你就合并好？”

与 30万 读者一起学Excel

VIP学员：这里有10多个工作簿，要合并在一个工作表中，这样方便做分析。

如果靠复制粘贴，确实需要花费不少时间，而有了这个模板，也就10秒搞定。

一起来看看卢子是如何使用这个模板，10秒合并10多个工作簿。

1.将模板跟所有工作簿放在同一个文件夹

2.打开模板，点击二维码合并，等待10秒钟，就合并完成。

源代码：

Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long, ShRcou As Long, ShCol As Integer Dim Num As Long, WbSht As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet For G = 1 To Sheets.Count WbSht = Replace(Left(MyName, Len(MyName) - 4), ".", "") & ";" & Wb.Sheets(G).Name If .UsedRange.Count = 1 Then ShCol = Wb.Sheets(G).UsedRange.Columns.Count ShRcou = Wb.Sheets(G).UsedRange.Rows.Count .Cells(1, ShCol + 1) = "合并名称" .Cells(1, ShCol + 1).Font.Bold = 1 .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, ShCol + 1).Resize(ShRcou - 1) = WbSht Wb.Sheets(G).UsedRange.Copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1) Else ShRcou = Wb.Sheets(G).UsedRange.Rows.Count .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, ShCol + 1).Resize(ShRcou - 1) = WbSht Wb.Sheets(G).Cells(2, 1).Resize(ShRcou, ShCol).Copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) End If Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop ActiveSheet.UsedRange.Borders.LineStyle = 1 Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"End Sub

平常多收藏几个模板，关键时刻就能帮你大忙。

推荐：制作目录和根据目录生成多个工作表

上篇：工程项目台账全自动生成模板

很多品牌都有自己的广告语，就如：怕上火，喝王老吉。这句广告语，在广东几乎无人不知。

如果给Excel不加班，也写一句广告语，要让人记忆深刻，你有何想法？

作者：卢子，清华畅销书作者，《Excel效率手册 早做完，不加班》系列丛书创始人，个人公众号：Excel不加班（ID：Excelbujiaban）