分享

Excel办公神技之

 荷塘月色XLX 2017-01-24

 

头条号名称

亲爱的读者,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开发工具下的工程编辑窗口下,然后点击运行按钮,就可以快速实现上述功能了。

如果喜欢这篇文章,请点赞。如果有好的建议,请发表评论。

谢谢大家宝贵的时间!!

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多