《VBA合并多个Excel工作簿几种数组》由会员分享，可在线阅读，更多相关《VBA合并多个Excel工作簿几种数组（3页珍藏版）》请在金锄头文库上搜索。
1、文档供参考，可复制、编制，期待您的好评与关注！ Sub CombineWorkbooks() Dim strFileName As String Dim wb As Workbook Dim ws As Object 包含工作簿的文件夹,可根据实际修改 Const strFileDir As String = D:示例数据记录 Application.ScreenUpdating = False Set wb = Workbooks.Add(xlWorksheet) strFileName = Dir(strFileDir & *.xls*) Do While strFileName vbNu
2、llString Dim wbOrig As Workbook Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True) strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29) For Each ws In wbOrig.Sheets ws.Copy After:=wb.Sheets(wb.Sheets.Count) If wbOrig.Sheets.Count 1 Then wb.Sheets(wb.Sheets.Cou
3、nt).Name = strFileName & ws.Index Else wb.Sheets(wb.Sheets.Count).Name = strFileName End If Next wbOrig.Close SaveChanges:=False strFileName = Dir Loop Application.DisplayAlerts = False wb.Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Set wb = NothingEnd SubSub
4、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 Ra
5、ngeArray(i) = & bk.Name & & sht.Name & ! & _ sht.Range(A1).CurrentRegion.Address(ReferenceStyle:=xlR1C1) End If Next Worksheets(1).Range(A1).Consolidate _ RangeArray, xlSum, True, TrueEnd SubSub UnionWorksheets() Application.ScreenUpdating = False Dim lj As String Dim dirname As String Dim nm As Str
6、ing lj = ActiveWorkbook.Path nm = ActiveWorkbook.Name dirname = Dir(lj & *.xls*) Cells.Clear Do While dirname If dirname nm Then Workbooks.Open Filename:=lj & & dirname Workbooks(nm).Activate 复制新打开工作簿的第一个工作表的已用区域到当前工作表 Workbooks(dirname).Sheets(1).UsedRange.Copy _ Range(A65536).End(xlUp).Offset(1, 0) Workbooks(dirname).Close False End If dirname = Dir LoopEnd Sub /
