|
头条号名称 亲爱的读者，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(r 1 & ':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.Count 1 fn = ThisWorkbook.Path & '\' & FileName Set wb = GetObject(fn) Set sht = wb.Worksheets(1) Num = Num 1 arr = sht.Range(sht.Cells(r 1, '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开发工具下的工程编辑窗口下，然后点击运行按钮，就可以快速实现上述功能了。 如果喜欢这篇文章，请点赞。如果有好的建议，请发表评论。 谢谢大家宝贵的时间！！ |
|
|
