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 For Each sht In Sheets If sht.Name 汇总 Then i = i + 1 RangeArray = & sht.Name & ! & _ sht.Range.CurrentRegion.Address End If Next bk.Range.Consolidate RangeArray, xlSum, True, True a1.Value = #End SubSub sumdemoDim arr As Variant arr = Array With Worksheets.Range .Consolidate arr, xlSum, True, True .Value = # End WithEnd Sub2,多工作簿汇总Consolidate多工作簿汇总Sub ConsolidateWorkbook Dim RangeArray As String Dim bk As Workbook Dim sht As Worksheet Dim WbCount As Integer WbCount = Workbooks.Count ReDim RangeArray For Each bk In Workbooks 在所有工作簿中循环 If Not bk Is ThisWorkbook Then 非代码所在工作簿 Set sht = bk.Worksheets 引用工作簿的第一个工作表 i = i + 1 RangeArray = & bk.Name & & sht.Name & ! & _ sht.Range.CurrentRegion.Address End If Next Worksheets.Range.Consolidate _ RangeArray, xlSum, True, TrueEnd Sub3,多工作簿汇总FileSearch2007-1-1.html#help汇总表.xlsSub pldrwb0531汇总表.xls导入指定文件的数据 Dim myFs As FileSearch Dim myPath As String, Filename$ Dim i As Long, n As Long Dim Sht1 As Worksheet, sh As Worksheet Dim aa, nm$, nm1$, m, arr, r1, col1%Application.ScreenUpdating = FalseSet Sht1 = ActiveSheet Set myFs = Application.FileSearch myPath = ThisWorkbook.Path With myFs .NewSearch .LookIn = myPath .FileType = msoFileTypeNoteItem .Filename = *.xls If .Execute 0 Then n = .FoundFiles.Count col1 = 2 ReDim myfile As String For i = 1 To n myfile = .FoundFiles Filename = myfile aa = InStrRev nm = RightFilename, Len - aa nm1 = Leftnm, Len - 4 If nm1 汇总表 Then Workbooks.Open myfile Dim wb As Workbook Set wb = ActiveWorkbook m = a65536.End.Row arr = RangeCells, Cells Sht1.Activate col1 = col1 + 1 Cells = nm 自动获取文件名 Cells.ResizeUBound, 1 = arr wb.Close savechanges:=False Set wb = Nothing End If Next Else MsgBox 该文件夹里没有任何文件 End If End With a1.Select Set myFs = NothingApplication.ScreenUpdating = TrueEnd Sub根据上例增加了在一个工作簿中可选择多个工作表进行汇总,运用了文本框多选功能Public ar, ar1, nm$Sub pldrwb0531汇总表.xls导入指定文件的数据默认工作表1的数据直接从C列依次导入 Dim myFs As FileSearch Dim myPath As String, Filename$ Dim i As Long, n As Long Dim Sht1 As Worksheet, sh As Worksheet Dim aa, nm1$, m, arr, r1, col1%Application.ScreenUpdating = FalseOn Error Resume NextSet Sht1 = ActiveSheet Set myFs = Application.FileSearch myPath = ThisWorkbook.Path With myFs .NewSearch .LookIn = myPath .FileType = msoFileTypeNoteItem .Filename = *.xls If .Execute 0 Then n = .FoundFiles.Count col1 = 2 ReDim myfile As String For i = 1 To n myfile = .FoundFiles Filename = myfile aa = InStrRev nm = RightFilename, Len - aa nm1 = Leftnm, Len - 4 If nm1 汇总表 Then Workbooks.Open myfile Dim wb As Workbook Set wb = ActiveWorkbook For Each sh In Sheets s = s & sh.Name & , Next s = Lefts, Len - 1 ar = Split UserForm1.Show For j = 0 To UBound If Err.Number = 9 Then GoTo 100 Set sh = wb.Sheetsar1 sh.Activate m = sh.a65536.End.Row arr = RangeCells, Cells