头条号名称亲爱的读者，Excel爱好者：大家新年好！特别是大量工作表的内容结构十分相似的情况下，这就需要我们对其做合并工作，以便我们进行统计工作。现在就和大家分享一种超级使用，快速合并工作表的方法。如果有好的建议，请发表评论。
头条号名称
亲爱的读者，Excel爱好者：
大家新年好！
在实际工作中，我们是否经常遇到许多的工作簿需要合并在一起的情形呢？
我想答案是肯定的。特别是大量工作表的内容结构十分相似的情况下，这就需要我们对其做合并工作，以便我们进行统计工作。
要是工作表张数不多的情况下（3-5张工作表），我们可以用复制一张工作表，再把它粘贴到一新的工作表中。问题关键是如果工作表张数特别多，甚至数百上千张工作表的情况下呢，这种复制粘贴的老法子是不是非常的恐怖呢？
朋友们，读者们，不用害怕！
现在就和大家分享一种超级使用，快速合并工作表的方法。
代码如下：
Sub CombineWbs()
Dim bt As Range, r As Long, c As Long
r = 1
c = 7
Dim wt As Worksheet
Set wt = ThisWorkbook.Worksheets(1)
wt.Rows(r1 & ":1048576").ClearContents
Application.ScreenUpdating = False
Dim FileName As String, sht As Worksheet, wb As Workbook, WbN As String
Dim Erow As Long, fn As String, arr As Variant, Num As Long
FileName = Dir(ThisWorkbook.Path & "\*.xlsx")
Num = 0
Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then
Erow = wt.Range("A1").CurrentRegion.Rows.Count1
fn = ThisWorkbook.Path & "\" & FileName
Set wb = GetObject(fn)
Set sht = wb.Worksheets(1)
Num = Num1
arr = sht.Range(sht.Cells(r1, "A"), sht.Cells(1048576, "B").End(xlUp).Offset(0, 7))
wt.Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
WbN = WbN & Chr(13) & wb.Name
wb.Close False
End If
FileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub
'以上代码，只要复制粘贴到Excel开发工具下的工程编辑窗口下，然后点击运行按钮，就可以快速实现上述功能了。
如果喜欢这篇文章，请点赞。如果有好的建议，请发表评论。
谢谢大家宝贵的时间！！
温馨提示：（1）需要合并的工作簿和执行合并的活动工作簿，二者必须在同一文件夹下；
（2）需要合并的工作表内容及结构相似。
