在日常生活中,经常会遇到一个文件夹中有很多个工作簿,这个时候需要把这些工作簿中的sheet全部汇总到一个工作簿中,应该如何做呢?如果一个一个打开然后将sheet复制粘贴,未免太没有效率了,这个时候我们通过VBA来解决这个问题,只需要执行代码,所有sheet会自动汇总到一个工作簿中。
如图,我们需要将图中所有的工作簿中的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中:
是不是很强大~
希望对大家有所帮助哦,记得点个赞哦^^