EXCEL——VBA实现将多个文件的sheet汇总到一个work

mammals-3218028_640.jpg

在日常生活中，经常会遇到一个文件夹中有很多个工作簿，这个时候需要把这些工作簿中的sheet全部汇总到一个工作簿中，应该如何做呢？如果一个一个打开然后将sheet复制粘贴，未免太没有效率了，这个时候我们通过VBA来解决这个问题，只需要执行代码，所有sheet会自动汇总到一个工作簿中。

image.png

如图，我们需要将图中所有的工作簿中的sheet全部汇总到11.xlsm这个工作簿中，这个时候我们应该要在11.xlsm中执行代码。老规矩，首先我们来分析一下代码，如下：

Sub 将多个文件的sheet汇总()
    Dim i
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    flnm = Dir(ThisWorkbook.Path & "\*.xlsm")
    Do While flnm <> ""
        Debug.Print ThisWorkbook.Path & "\" & flnm
        fn = ThisWorkbook.Path & "\" & flnm
        If flnm <> "11.xlsm" Then
            Debug.Print TypeName(flnm); 查看一下数据类型
            Set wb = Workbooks.Open(fn)
                For Each x In wb.Sheets
                    x.Name = Split(flnm, ".")(0)
                    x.UsedRange.Copy
                    ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = Split(flnm, ".")(0)
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Paste
                Next
        End If
        flnm = Dir
    Loop
End Sub

上述代码中，前两行
Application.ScreenUpdating = False
Application.DisplayAlerts = False
是为了加快运行速度，暂停表格刷新和禁止弹出框。

flnm = Dir(ThisWorkbook.Path & "\*.xlsm")
    Do While flnm <> ""
        Debug.Print ThisWorkbook.Path & "\" & flnm
        fn = ThisWorkbook.Path & "\" & flnm
        If flnm <> "11.xlsm" Then
        ...
        End If
        flnm = Dir
    Loop

上面这几句代码是对这个工作簿路径下的xlsm文件进行遍历，然后当flnm <> 11.xlsm时执行下面的代码

Debug.Print TypeName(flnm); 查看一下数据类型
            Set wb = Workbooks.Open(fn)
            For Each x In wb.Sheets
                    x.Name = Split(flnm, ".")(0)
                    x.UsedRange.Copy
                    ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = Split(flnm, ".")(0)
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Paste
            Next

即是对工作簿中的sheet进行遍历、改名、并将内容复制给11.xlsm新创建的sheet。。
这样对整个文件夹下的xlsm文件遍历一遍过后，就能把所有的sheet都汇总到11.xlsm中：

3月-21-2018 22-07-22.gif

是不是很强大~
希望对大家有所帮助哦，记得点个赞哦^^