VBA_11_合并其他工作簿中的各个工作表中的数据

浏览: 1969

首先介绍一下背景,23日上韦玮老师的Python课,留的作业就是这个,如题,Python小白表示不会写,答案看不懂~(已哭晕三次。。。)


那么,我还是用VBA实现一下吧!给自己涨点自信~ ^_^


分两种情况:

一、复制多个工作簿中的多个工作表到一个汇总工作簿里。

 源文件如下图:

p1.png

需要达到的汇总效果如下图:

p2.png

思路:

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中。

 源文件如下图:

同上源文件

需要达到的汇总效果如下图:

p3.png

思路:

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

以上问题类似的代码非常多,但大概都是那几句,网上搜一下自己改改即可使用。

<半原创>

推荐 1
本文由 okajun 创作,采用 知识共享署名-相同方式共享 3.0 中国大陆许可协议 进行许可。
转载、引用前需联系作者,并署名作者且注明文章出处。
本站文章版权归原作者及原出处所有 。内容为作者个人观点, 并不代表本站赞同其观点和对其真实性负责。本站是一个个人学习交流的平台,并不用于任何商业目的,如果有任何问题,请及时联系我们,我们将根据著作权人的要求,立即更正或者删除有关内容。本站拥有对此声明的最终解释权。

0 个评论

要回复文章请先登录注册