Excel-VBA-多工作簿多工作表汇总实例集锦
Excel高效办公VBA代码-快速将多个工作簿合并到一张工作表
快速将多个工作簿合并到一张工作表作者原著，尊重成果，侵权必究一、应用场景我们很多时候，导出数十份excel格式，文本格式的文档；这些文档的格式一致，我们需要将它们合并到一张工作表中，而且合并后不会重复表头。
通常要一张张打开，复制，耗时耗力。
利用vba代码将可以一键实现将多份文件，一秒钟快速合并到一张工作表中。
二、示例1.要求：需要该工作簿的所有表格，单独保存为工作簿2.做法：利用vba代码，实现一键将多份工作簿，合并到一张工作表内，并在最后一列说明工作表的名称，以作标识需要这些工作簿合并到一张工作表中（格式相同）新建一份要合并到的工作簿，点击自定义宏中“合并文件”按钮输入要合并文件的路径输入要合并的格式实现合并三、重点：vba源代码如下（具有通用性）Sub 合并文件需新建()On Error Resume NextDim MyPath, MyNameDim Wb As Workbook, WbN As StringDim G As Long, Num As Long, i, jApplication.ScreenUpdating = FalseMyPath = InputBox("请输入要合并的文件路径")gs = InputBox("请输入文件格式，如：xls")If MyPath <> "" And gs <> "" ThenMyName = Dir(MyPath & "\" & "*." & gs & "*") '注意修改文件格式Num = 0Set Wb = Workbooks.Open(MyPath & "\" & MyName)For G = 1 To Sheets.CountWb.Sheets(G).UsedRange.Copy Workbooks(1).Sheets(1).Cells(Workbooks(1). _Sheets(1).Range("B1048576").End(xlUp).Row, 1)NextMyName = DirDo While MyName <> ""Set Wb = Workbooks.Open(MyPath & "\" & MyName)Num = Num + 1For G = 1 To Sheets.Counti = Wb.Sheets(G).Range("B1048576").End(xlUp).Rowj = Wb.Sheets(G).Cells(1, 16384).End(xlToLeft).Column '不复制表头Wb.Sheets(G).Range(Cells(2, 1), Cells(i, j)).Copy Workbooks(1).Sheets(1) _.Cells(Workbooks(1).Sheets(1).Range("B1048576").End(xlUp).Row + 1, 1) NextWbN = WbN & Chr(13) & Wb.CloseMyName = DirLoopWorkbooks(1).Sheets(1).ActivateActiveSheet.Range("a1").SelectSelection.AutoFilterActiveSheet.Range("a2").SelectActiveWindow.FreezePanes = TrueApplication.DisplayAlerts = FalseWorkbooks(1).SaveApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueMsgBox "共合并了" & Num & "个工作薄下的全部工作表。
VBA对多个工作簿进行合并计算（求和）一例
VBA对多个工作簿进行合并计算（求和）一例VBA对多个工作簿进行合并计算（求和）一例Excel中的合并计算可以对多个工作表的对应项目进行求和、求平均值等计算，但如果需要合并计算的工作表较多，特别是这些工作表位于不同的工作簿内时，逐一选择数据源显得较为繁琐。
用VBA中的Range.Consolidate方法可以快速地对多个结构相似的工作表进行合并计算，但如果表格内包含有非数值类型的数据列，合并计算会忽略这些列。
例如下图为某个图书销售点1至12月的图书销售记录，销售数量位于D至O列，其中B列和C列为与A列对应的数据，无需参与合并计算，但必须在汇总表中列出。
各销售点都有一个类似的销售表格，每个分表列出的图书数量不等，图书名称也不尽相同。
现在需要对各销售点的销售表格中D至O列的销售数量按照A列图书名称进行合计，求出总的销售数量。
如果直接使用合并计算，Excel会忽略B列文本，同时对C列（单价）也进行合并计算，显然不符合要求。
这时使用VBA中的Dictionary对象，可以解决这一问题，代码如下：Sub SumWorkbooks()Dim ThePath As String, TheFile As StringDim d As Object, Wbk As WorkbookDim i As Integer, j As Integer, k As IntegerDim Arr1(11), Arr2(), Arr3(), dkOn Error Resume NextApplication.ScreenUpdating = FalseSet d = CreateObject("scripting.dictionary")ThePath = ThisWorkbook.Path & "\"TheFile = Dir(ThePath & "*.xls")Do While TheFile <> ""If TheFile <> ThenSet Wbk = GetObject(ThePath & TheFile)With Wbk.Worksheets(1)For i = 2 To .Range("A65536").End(xlUp).Row'将D至O列数值赋值给Arr1For j = 0 To 11Arr1(j) = .Cells(i, j + 4).ValueNext jIf Not d.exists(.Range("A" & i).Value) Then'key对应一个数组d.Add .Range("A" & i).Value, Arr1'将不能求和的数据赋值给Arr2ReDim Preserve Arr2(1 To 2, 1 To k + 1)For j = 1 To 2Arr2(j, k + 1) = .Cells(i, j + 1)Next jk = k + 1ElseFor j = 0 To 11'若数据存在则D至O列数值对应合计到Arr1中的每个元素Arr1(j) = d(.Range("A" & i).Value)(j) + Arr1(j)Nextd(.Range("A" & i).Value) = Arr1End IfNextEnd WithWbk.Close FalseEnd IfTheFile = Dir '当前文件夹内的下一个工作簿Loop'输出With ThisWorkbook.Worksheets(1).Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)dk = d.keysReDim Arr3(1 To d.Count, 1 To 12)For i = 0 To d.Count - 1For j = 0 To 11Arr3(i + 1, j + 1) = d(dk(i))(j)Next jNext i.Range("D2:O" & d.Count + 1).Value = Arr3.Range("B2:C" & d.Count + 1).Value = Application.Transpose(Arr2)End WithSet d = NothingApplication.ScreenUpdating = TrueEnd Sub在汇总表中按Alt+F11，打开VBA编辑器，单击菜单“插入→模块”，粘贴上述代码并运行，即可对汇总工作簿所在的文件夹内的其他所有工作簿的第一个工作表进行合并求和，无需打开各个需要汇总的工作簿。
如何使用ExcelVBA将多个工作簿的全部工作表合并到一个工作簿中
如何使用ExcelVBA将多个工作簿的全部工作表合并到一个工作簿中本文转载自公众号：Office学霸办公软件，作者：Office学霸。
本文著作权归原创作者所有，本人收藏此文仅作为学习之用，不作其他目的，如有侵权请联系我删除。
在一些操作中，往往会需要将多个工作簿进行合并。
一般的操作方法都是打开两个工作簿，然后选中需要移动的工作表，右键单击以后选择“移动或复制”。
接下来在新的窗口里面进行设置就可以了。
这种方法适合在移动数量较少的工作表的时候使用。
如果有很多的工作簿，都需要进行移动的话，一个一个打开然后再操作肯定是比较麻烦耗时的。
这时就可以使用VBA来批量进行操作。
如图，现在在一个文件夹里面有几个工作簿，里面分别有不同数量的工作表。
另外还有一个启用宏的汇总表。
下面就需要使用VBA将工作簿1-3汇总到那个总表中。
打开汇总工作簿，然后运行以下代码：••••••••••••••Sub MergeWorkbook() Application.ScreenUpdating = False Path = 'C:\Users\Administrator\Desktop\新建文件夹' Filename = Dir(Path & '\*.xlsx') While Filename <> '' Set wb = Workbooks.Open(Path & '\' & Filename) For Each Sheet In ActiveWorkbook.Sheets i = Workbooks('汇总.xlsm').Sheets.Count Sheet.Copy After:=Workbooks('汇总.xlsm').Sheets(i) Next Sheet wb.Close Filename = Dir WendEnd Sub运行以后其他工作簿里面的工作表就全部复制到汇总工作簿中了。
Excel VBA_多工作簿多工作表汇总实例集锦
Excel VBA_多工作簿多工作表汇总实例集锦excelvba_多工作簿多工作表汇总实例集锦1，多工作表汇总（consolidate）dimrangearray()asstringdimbkasworksheetdimshtasworksheetdimwbcountasintegerset bk=sheets(\汇总\wbcount=sheets.countredimrangearray(1towbcount-1)foreachshtinsheets<>\汇总\i=i+1rangearray(i)=\sht.range(\endifnextbk.range(\[a1].value=\姓名\endsubsubsumdemo()dimarrasvariantarr=array(\一月!r1c1:r8c5\二月!r1c1:r5c4\三月!r1c1:r9c6\withworksheets(\汇总\.consolidatearr,xlsum,true,true.value=\姓名\endwithendsub2，多工作簿汇总（consolidate）‘多工作簿汇总subconsolidateworkbook()dimrangearray()asstringdimbkasworkbookdimshtasworksheetdimwbcountasintegerwbcount=workbooks.countredimrangearray(1towbcount-1)foreachbkinworkbooks'在所有工作簿中循环ifnotbkisthisworkbookthen'非代码所在工作簿setsht=bk.worksheets(1)'提及工作簿的第一个工作表i=i+1rangearray(i)=\sht.range(\endifnextworksheets(1).range(\rangearray,xlsum,true,trueendsub3，多工作簿汇总（filesearch）'导入指定文件的数据dimmyfsasfilesearchdimmypathasstring,filename$dimiaslong,naslongdimsht1asworksheet,shasworksheetdimaa,nm$,nm1$,m,arr,r1,col1%application.scree nupdating=falsesetsht1=activesheetsetmyfs=application.filesearchmypath=thisworkbook.pathwithmyfs.newsearch.lookin=mypath.filetype=msofiletypenoteitem.filename=\if.execute(sortby:=msosortbyfilename)>0thenn=.foundfiles.countcol1=2redimmyfile(1ton)asstringfori=1tonmyfile(i)=.foundfiles(i)filename=myfile(i)aa=instrrev(filename,\nm=right(filename,len(filename)-aa)nm1=left(nm,len(nm)-4)ifnm1<>\汇总表\workbooks.openmyfile(i)dimwbasworkbooksetwb=activeworkbookm=[a65536].end(xlup) .rowarr=range(cells(3,3),cells(m,3))sht1.activatecol1=col1+1cells(2,col1)=nm'自动获取文件名cells(3,col1).resize(ubound(arr),1)=arrwb.closesavechanges:=falsesetwb=nothing endifnextelsemsgbox\该文件夹里没任何文件\endifendwith[a1].selectsetmyfs=nothingapplication.screenupdating=trueendsub‘根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能publicar,ar1,nm$subpldrwb0531()'汇总表.xls'引入选定文件的数据（预设工作表1的数据）'轻易从c列依次引入dimmyfsasfilesearchdimmypathasstring,filename$dimiaslong,naslongdimsht1asworksheet,shasworksheetdimaa,nm1$,m,arr,r1,col1%application.screenupd ating=falseonerrorresumenextsetsht1=activesheetsetmyfs=application.filesearchmypath=thisworkbook.pathwithmyfs.newsearch.lookin=mypath.filetype=msofiletypenoteitem.filename=\if.execute(sortby:=msosortbyfilename)>0thenn=.foundfiles.count\+2,col1))100:col1=2redimmyfile(1ton)asstringfori=1tonmyfile(i)=.foundfiles(i)filename=myfile(i)aa=instrrev(filename,\nm=right(filename,len(filename)-aa)nm1=left(nm,len(nm)-4)ifnm1<>\汇总表\workbooks.openmyfile(i)dimwbasworkbooksetwb=activeworkbookforeachshinsheetss=s&&\nexts=left(s,len(s)-1)ar=split(s,\userform1.showforj=0toubound(ar1)iferr.number=9thengoto100setsh=wb.sheets(ar1(j))sh.activatem=sh.[a65536].end(xlup).rowarr=range(cells(3,3),cells(m,3))sht1.activatecol1=c ol1+1cells(2,col1)=sh.[a1]cells(3,col1).formular1c1=\&nm&\&ar1(j)&‘显示引用的工作簿工作表及单元格地址cells(3,col1).auto fillrange(cells(3,col1),cells(ubound(arr)‘cells(3,col1).res ize(ubound(arr),1)=arrnextjwb.closesavechanges:=falsesetwb=nothings=\ifvartype(ar1)=8200thenerasear1endifnextelsemsgbox\该文件夹里没任何文件\endifendwith[a1].selectsetmyfs=nothingapplication.screenupdating=trueendsubiflistbox1.selected(i)=truethens=s&listbox1.list(i)&\endifnextiifs<>\s=left(s,len(s)-1)ar1=split(s,\msgbox\你挑选了\unloaduserform1elsemg=msgbox(\你没有选择任何工作表！需要重新选择吗？ifmg=6thenelseunloaduserform1endifendifendsubendsubprivatesubuserform_initialize()withme.listbox1.list=ar‘文本框赋值.liststyle=1‘文本ka挑选大方框.multiselect=1‘设置可以多挑选\提示\。
使用VBA合并多个Excel工作簿的几个例子 MY
使用VBA合并多个Excel工作簿的几个例子将许多个工作簿中的工作表合并到一个工作薄中,然后对数据进行统计计算,举了几种合并的案例。
Sub 合并工作簿()Application.DisplayAlerts = False '关闭提示窗口shes = Application.SheetsInNewWorkbook '工作簿中包含工作表数Application.SheetsInNewWorkbook = 1 '生成的新工作簿中只有一个工作表Set newbok = Workbooks.Add '生成新工作簿Set newshe = newbok.Worksheets(1) '新工作表s = 1 '从新工作表的第一行写入数据na = Dir("d:\123\*.xls") '需要合并的所有工作表都要事先保存在D盘time文件夹下Do While na <> ""Set wb = Application.Workbooks.Open("d:\123\" & na)wb.Worksheets(1).UsedRange.Copy '复制数据newbok.ActivateCells(s, 1).SelectActiveSheet.Paste '执行粘贴s = edRange.Rows.Count + 1Cells(s, 1) = '写入数据所属的工作簿名字s = s + 1wb.Close '关闭工作簿na = Dir() '取下一个工作簿LoopApplication.SheetsInNewWorkbook = shesApplication.DisplayAlerts = TrueRange("a1").SelectEnd Sub///把多个工作簿中的第一个工作表中的数据合并到一个工作簿的一个工作表中Sub Com()Dim MyPath, MyName, A WbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xls")A WbName = Num = 0Do While MyName <> ""If MyName <> A WbName ThenSet Wb = Workbooks.Open(MyPath & "\" & MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Wb.Sheets.CountWb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)NextWbN = WbN & Chr(13) & Wb.Close FalseEnd WithEnd IfMyName = DirLoopRange("A1").SelectMyName = DirLoopRange("A1").SelectApplication.ScreenUpdating = TrueMsgBox "共合并了" & Num & "个工作薄下的全部工作表。
VBA处理Excel中的多工作簿和多工作表
VBA处理Excel中的多工作簿和多工作表VBA（Visual Basic for Applications）是一种编程语言，可以用来处理Excel中的多个工作簿和工作表。
它提供了丰富的功能，可以自动进行数据处理、格式调整、图表生成等任务。
在本文中，我将详细介绍如何使用VBA处理Excel中的多个工作簿和工作表。
首先，我们先了解一下VBA中的对象和方法。
在Excel中，有几个重要的对象需要我们熟悉：Application对象、Workbook对象和Worksheet对象。
Application对象表示Excel应用程序本身，Workbook对象表示一个Excel工作簿，而Worksheet对象表示一个工作簿中的一个工作表。
我们可以使用这些对象的方法来操作和处理Excel中的数据。
接下来，我将分别介绍如何处理多个工作簿和多个工作表的情况。
处理多个工作簿：1. 打开工作簿：使用Workbooks.Open方法可以打开一个或多个工作簿。
例如，可以使用以下代码打开一个名为"Book1.xlsx"的工作簿：```Workbooks.Open("C:\Users\UserName\Documents\Book1.xlsx")```2. 复制数据：使用Workbook对象的Copy方法可以将一个工作簿的数据复制到另一个工作簿。
例如，可以使用以下代码将"Book1.xlsx"中的数据复制到"Book2.xlsx"中的Sheet1：Workbooks("Book1.xlsx").Sheets("Sheet1").UsedRange.CopyWorkbooks("Book2.xlsx").Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues```3. 保存工作簿：使用Workbook对象的Save方法可以保存工作簿。
VBA实现Excel多表格汇总
件 、若仅川 于 Ｏｆｉｃｅ２００７及 以 卜版本 ，＿『修 改第 １０和 ３０句 ．．
图 ２
相信操 作 Ｅｘｔ－ｅｌ的川 户大都 会遇 上多个 表 格汇总 ， 往往是在同一 个史什巾插入 多个 Ｓｈｅｅｔｓ并 复制上 分别要 汇总的表 格 ，再 川ｔ “∑”或公 式及 复制完成 有 多 个文件 、多个表格及 多个数据块 汇总时 如图 １分别是 总公 司存一个Ｔ作簿 史件 的 ３个汇 总表 ．其中各数据块 （Ａ—Ｃ数据 块 ）的 元格 数据 为 从 图 ２的 “分 公 司 １． ｘｌｓ”一 “分公 司 ６．ｘｌｓ” 中报 表 （报表 ｌ、报表 ２、报 表 ３）对应单元格 累加 的汇总 ，手 丁编辑时通 常是在 Ａ数 据块 的左 上单元 格输 入 “＝『分 公司 １．ｘｌｓ］报 表 ｌ！Ｂ４＋
４０ Ｅｎｄ Ｉｆ ５０ Ｆｏｒ ｉ＝２ Ｔｏ ＬａｓｔＳｈｅｅｔｓ
６０ Ｆｏｒ ｊ：１ Ｔｏ ７ ７０ Ｔ Ｓｔｒ＝ Ｍ ｉｄ（ ＩＶ： ７ ｊ）
＿
８０ Ｉｆ Ｉｎｓｔｒ（Ｒａｎｇｅ（“ｄ ＆ ｉ），Ｔ—Ｓｔｒ）Ｔｈｅｎ ９０ ＭｓｇＢｏｘ”表名错误 ！ＩＩ：Ｅｎｄ １ Ｏ０ Ｅｎｄ Ｉｆ １ １ Ｏ Ｎｅｘｔ １２０ ０ ｋ＝Ｔｒｕｅ １３０ Ｆｏｒ Ｅａｃｈ ｊ ｉｎ Ｓｈｅｅｔｓ １４０ Ｉｆ Ｔ Ｓｔｒ＝ｊ．Ｎａｍｅ Ｔｈｅｎ Ｏｋ＝一
１ ｉ分 公 司 名 是 否 汇 总
量一ｉ盆蛰蜀 — 经 ｉＬ盘——一
ｓ 公 司 ２ 待 忙 总
哇 ｉ分 公 司３ ｇ １分 公 司４
椿 ｝ｆ息 待 汇 总
６ ｝分 公 司 ５ ７ ：分 公 司 ６ ８ １
椿 汇 总 祷 奠
譬跬鞠黼龋瓣隅糟瓣麟 罐 §：
４０ Ｆｏｒ ｉ＝１ ＴＯ ９
用VBA代码快速实现多表数据汇总
Excel多个工作表合并至一个工作表！ 效果如下所示：
要求汇总至一个工作表
1多个工作表
表一数据：
姓名定位性别程咬金坦克男刘禅坦克男墨子坦克男亚瑟坦克男钟无艳坦克女
表二数据：
表三数据：
2传统方法：
使用ALT+D+P功能的多重合并计算，但是在添加字段时，如果存在100张表格，那么这种方法的效率是极低的
3VBA代码
那么只需要使用VBA方法，就能轻松快速的解决，如果你的字段不是3个，那么仅需将下面字段中的标红位置进行相应修改即可！
VBA代码
Sub 多表合并()
Dim arr()
For Each sh In Sheets
If <> '汇总' Then
arr1 = sh.Range('a2:c' & edRange.Rows.Count)
act = act + UBound(arr1)
ReDim Preserve arr(1 To 3, 1 To act) '
For j = 1 To UBound(arr1)
n = n + 1
arr(1, n) = arr1(j, 1)
arr(2, n) = arr1(j, 2)
arr(3, n) = arr1(j, 3)
Next
End If
Next
Sheets('汇总').[a2].Resize(n, 3) = Application.Transpose(arr)
End Sub
将文件另存为xlsm格式，要不然重新打开文件时这段代码就消失了！。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
1，多工作表汇总（Consolidate）
‘
‘两种写法都要求地址用R1C1形式，各个表格的数据布置有规定。
Sub ConsolidateWorkbook()
Dim RangeArray() As String
Dim bk As Worksheet
Dim sht As Worksheet
Dim WbCount As Integer
Set bk = Sheets("汇总")
WbCount = Sheets.Count
ReDim RangeArray(1 To WbCount - 1)
For Each sht In Sheets
If <> "汇总" Then
i = i + 1
RangeArray(i) = "'" & & "'!" & _
sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)
End If
Next
bk.Range("A1").Consolidate RangeArray, xlSum, True, True
[a1].Value = "姓名"
End Sub
Sub sumdemo()
Dim arr As Variant
arr = Array("一月!R1C1:R8C5", "二月!R1C1:R5C4", "三月!R1C1:R9C6") With Worksheets("汇总").Range("A1")
.Consolidate arr, xlSum, True, True
.Value = "姓名"
End With
End Sub
2，多工作簿汇总（Consolidate）
‘多工作簿汇总
Sub ConsolidateWorkbook()
Dim RangeArray() As String
Dim bk As Workbook
Dim sht As Worksheet
Dim WbCount As Integer
WbCount = Workbooks.Count
ReDim RangeArray(1 To WbCount - 1)
For Each bk In Workbooks '在所有工作簿中循环
If Not bk Is ThisWorkbook Then '非代码所在工作簿
Set sht = bk.Worksheets(1) '引用工作簿的第一个工作表
i = i + 1
RangeArray(i) = "'[" & & "]" & & "'!" & _ sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)
End If
Next
Worksheets(1).Range("A1").Consolidate _
RangeArray, xlSum, True, True
End Sub
3，多工作簿汇总（）
‘2007-1-1.html###
‘help\汇总表.xls
Sub pldrwb0531()
'汇总表.xls
'导入指定文件的数据
Dim myFs As
Dim myPath As String, $
Dim i As Long, n As Long
Dim Sht1 As Worksheet, sh As Worksheet
Dim aa, nm$, nm1$, m, arr, r1, col1%
Application.ScreenUpdating = False
Set Sht1 = ActiveSheet
Set myFs = Application.
myPath = ThisWorkbook.Path
With myFs
.NewSearch
.LookIn = myPath
. = mso
. = "*.xls"
If .Execute(SortBy:=msoSortBy) > 0 Then
n = .Found
col1 = 2
ReDim myfile(1 To n) As String。