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‘设置可以多挑选\提示\。
vba10个excel表每个表2个子文件夹合并汇总在Excel VBA中，如果你想要合并10个Excel工作簿（每个工作簿位于两个子文件夹中）的数据到一个汇总工作簿，你可以使用以下步骤来编写代码：1.确定子文件夹和文件的路径。
2.循环遍历每个子文件夹中的每个工作簿。
3.打开每个工作簿，并复制需要的数据到汇总工作簿。
4.关闭每个工作簿。
以下是一个示例VBA代码，用于合并两个子文件夹中的10个Excel工作簿的数据：vba复制代码Sub MergeWorkbooks()Dim SummaryWorkbook As WorkbookDim SourceWorkbook As WorkbookDim SourceRange As RangeDim DestRange As RangeDim LastRow As LongDim FolderPath1 As StringDim FolderPath2 As StringDim FileName As StringDim i As Integer' 设置两个子文件夹的路径FolderPath1 = "C:\SubFolder1\"FolderPath2 = "C:\SubFolder2\"' 创建汇总工作簿（如果它不存在的话）If Workbooks("MergedData.xlsx").Count = 0 Then Set SummaryWorkbook = Workbooks.AddSummaryWorkbook.SaveAsFilename:="C:\MergedData.xlsx"ElseSet SummaryWorkbook =Workbooks("MergedData.xlsx")End If' 初始化行计数器i = 1' 循环遍历第一个子文件夹中的文件FileName = Dir(FolderPath1 & "*.xlsx")Do While FileName <> ""' 打开源工作簿Set SourceWorkbook = Workbooks.Open(FolderPath1 & FileName)' 假设你要合并的数据位于每个工作簿的Sheet1Set SourceRange =SourceWorkbook.Sheets("Sheet1").UsedRange' 将数据复制到汇总工作簿的下一行LastRow =SummaryWorkbook.Sheets("Sheet1").Cells(SummaryWorkb ook.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row + 1 Set DestRange =SummaryWorkbook.Sheets("Sheet1").Range("A" & LastRow)SourceRange.Copy DestRange' 关闭源工作簿，不保存更改SourceWorkbook.Close SaveChanges:=False' 移动到下一个文件FileName = Dir()i = i + 1Loop' 重置i用于第二个子文件夹i = 1' 循环遍历第二个子文件夹中的文件FileName = Dir(FolderPath2 & "*.xlsx")Do While FileName <> ""' 打开源工作簿Set SourceWorkbook = Workbooks.Open(FolderPath2 & FileName)' 假设你要合并的数据位于每个工作簿的Sheet1Set SourceRange =SourceWorkbook.Sheets("Sheet1").UsedRange' 将数据复制到汇总工作簿的下一行LastRow =SummaryWorkbook.Sheets("Sheet1").Cells(SummaryWorkb ook.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row + 1 Set DestRange =SummaryWorkbook.Sheets("Sheet1").Range("A" &LastRow)SourceRange.Copy DestRange' 关闭源工作簿，不保存更改SourceWorkbook.Close SaveChanges:=False' 移动到下一个文件FileName = Dir()i = i + 1Loop' 保存并关闭汇总工作簿SummaryWorkbook.SaveSummaryWorkbook.Close' 提示用户合并完成MsgBox "所有数据已成功合并到MergedData.xlsx"End Sub确保替换代码中的文件夹路径 C:\SubFolder1\ 和 C:\SubFolder2\ 为你实际的文件夹路径，以及确保你要合并的工作表名称是"Sheet1"。
不同工作薄汇总VBA代码以下是一个用于将不同工作簿数据汇总的VBA代码示例，代码注释中有详细说明每一行代码的作用：```vbaSub 汇总不同工作簿数据Dim SummarySheet As Worksheet ' 汇总数据的工作表Set SummarySheet = ThisWorkbook.Sheets("汇总") ' 设置汇总数据的工作表名称Dim SourceFolder As String ' 存储源文件夹路径SourceFolder = "C:\SourceFolder" ' 设置源文件夹路径Dim FileExtension As String ' 存储文件扩展名FileExtension = "*.xlsx" ' 设置文件扩展名Dim FileName As String ' 存储文件名FileName = Dir(SourceFolder & "\" & FileExtension) ' 获取第一个文件Dim LastRow As Long ' 存储汇总数据的最后一行LastRow = SummarySheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' 获取汇总数据的最后一行Application.ScreenUpdating = False ' 关闭屏幕更新，加快代码执行速度Do While FileName <> "" ' 循环直到没有文件为止Dim SourceWorkbook As Workbook ' 存储源工作簿Set SourceWorkbook = Workbooks.Open(SourceFolder & "\" & FileName) ' 打开源工作簿Dim SourceSheet As Worksheet ' 存储源工作表Set SourceSheet = SourceWorkbook.Sheets("数据") ' 设置源工作表名称Dim LastRowSource As Long ' 存储源数据的最后一行LastRowSource = SourceSheet.Cells(Rows.Count,1).End(xlUp).Row ' 获取源数据的最后一行Dim SourceRange As Range ' 存储源数据的范围Set SourceRange = SourceSheet.Range("A2:G" & LastRowSource) ' 设置源数据的范围SourceRange.Copy SummarySheet.Cells(LastRow, 1) ' 将源数据复制到汇总数据的下一行SourceWorkbook.Close SaveChanges:=False ' 关闭源工作簿LastRow = SummarySheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' 更新汇总数据的最后一行FileName = Dir ' 获取下一个文件LoopApplication.ScreenUpdating = True ' 打开屏幕更新End Sub```这段代码假设要将位于文件夹路径`C:\SourceFolder`中名为`数据.xlsx`的工作簿的"数据"工作表数据汇总到当前工作簿的"汇总"工作表中。
Excel利⽤VBA汇总表格多个表汇总到⼀个表中不同的sheetSub wen⼀键合并()'定义对话框变量Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFilePicker)'新建⼀个⼯作簿Dim newwb As WorkbookSet newwb = Workbooks.AddWith fdIf .Show = -1 Then'定义单个⽂件变量Dim vrtSelectedItem As Variant'定义循环变量Dim i As Integeri = 1'开始⽂件检索For Each vrtSelectedItem In .SelectedItems'打开被合并⼯作簿Dim tempwb As WorkbookSet tempwb = Workbooks.Open(vrtSelectedItem)'复制⼯作表tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)'把新⼯作簿的⼯作表名字改成被复制⼯作簿⽂件名，这⼉应⽤于xls⽂件，即Excel97-2003的⽂件，如果是Excel2007，需要改成xlsx newwb.Worksheets(i).Name = VBA.Replace(, ".xls", "")'关闭被合并⼯作簿tempwb.Close SaveChanges:=Falsei = i + 1Next vrtSelectedItemEnd IfEnd WithSet fd = NothingEnd SubVBA汇总多个⼯作表Sub 合并多个⼯作簿()Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet, m&Set sh = ActiveSheetMyPath = ThisWorkbook.Path & "\"MyName = Dir(MyPath & "*.*")Application.ScreenUpdating = FalseCells.ClearContentsDo While MyName <> ""If MyName <> ThenWith GetObject(MyPath & MyName)For Each sht In .SheetsIf IsSheetEmpty = IsEmpty(edRange) Thenm = m + 1If m = 1 Thensht.[a1].CurrentRegion.Copy sh.[a1]Elsesht.[a1].CurrentRegion.Copy sh.[a65536].End(xlUp).Offset(1)End IfEnd IfNext.Close FalseEnd WithEnd IfMyName = DirLoopApplication.ScreenUpdating = True End Sub。
