首先介绍一下背景,23日上韦玮老师的Python课,留的作业就是这个,如题,Python小白表示不会写,答案看不懂~(已哭晕三次。。。)
那么,我还是用VBA实现一下吧!给自己涨点自信~ ^_^
分两种情况:
一、复制多个工作簿中的多个工作表到一个汇总工作簿里。
源文件如下图:
需要达到的汇总效果如下图:
思路:
1、打开文件夹下的所有工作簿
2、获取每个工作簿中工作表的个数,一个个复制到汇总工作簿中
代码如下:
Sub UnionWorksheets() '*****汇总本工作簿所在文件夹下所有的.xlsx文件中所有工作表到本工作簿中的各个sht*****
Application.ScreenUpdating = False
Dim ipath As String
Dim dirname As String
Dim nm As String
Dim i%, j%, m%
ipath = ThisWorkbook.Path
nm = ActiveWorkbook.Name
dirname = Dir(ipath & "\*.xlsx")
Do While dirname <> ""
Workbooks.Open Filename:=ipath & "\" & dirname
j = Workbooks(dirname).Sheets.Count
For m = 1 To j
Workbooks(dirname).Sheets(m).Copy after:=Workbooks(nm).Sheets(Sheets.Count) '保留源表名称,为防止重名,加上工作表个数序号
ActiveSheet.Name = ActiveSheet.Name & Sheets.Count
Next m
i = i + 1
Workbooks(dirname).Close
dirname = Dir
Loop
Application.ScreenUpdating = True
End Sub
二、复制多个工作簿中的多个工作表中的数据到一个汇总工作簿中的汇总sht中。
源文件如下图:
同上源文件
需要达到的汇总效果如下图:
思路:
1、打开文件夹下的所有工作簿
2、获取每个工作簿中工作表的个数,一个个复制区域数据到汇总工作簿中的汇总工作表中
代码如下:
Sub UnionWorksheets_to_onesht() '*****汇总本工作簿所在文件夹下所有的.xlsx文件中所有工作表到本工作簿中的Sheets("汇总")*****
Application.ScreenUpdating = False '关闭屏幕更新
Dim ipath As String
Dim dirname As String
Dim nm As String
Dim i%, j%, m%
ipath = ActiveWorkbook.Path
nm = ActiveWorkbook.Name
dirname = Dir(ipath & "\*.xlsx") '打开工作簿
Do While dirname <> ""
Workbooks.Open Filename:=ipath & "\" & dirname
j = Workbooks(dirname).Sheets.Count '获取工作簿中的工作表个数
For m = 1 To j
Workbooks(dirname).Sheets(m).Activate '关键步骤,若无则出错,激活第一张工作表
Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.Copy
ThisWorkbook.Activate
Sheets("汇总").Select
Range("a" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next m
i = i + 1
Workbooks(dirname).Close
dirname = Dir
Loop
Application.ScreenUpdating = True
End Sub
以上问题类似的代码非常多,但大概都是那几句,网上搜一下自己改改即可使用。
<半原创>