如何快速的合并多个 Excel 工作簿成为一个工作簿？

晚上试了一下，楼主的方法可行，谢谢。 补充一点，如果是 2007版本，把 代码中的 xls 修改为 xlsx就可以了。
关注者
1,114
被浏览
702,728

38 个回答

之前写过一个真实的案例，可以参考下，这是最复杂的情况之一，请看下面介绍：

-----------------------------------------------------------------------

1、

一个文件夹下有很多个工作簿。

2、

每个工作簿里面有3个sheet表，结构一样。

-----------------------------------------------------------------------

3、

要求如上，根据名称、代号、长度三个条件，汇总数量。这是多工作簿，多工作表，多条件汇总。具有代表性。

-----------------------------------------------------------------------

代码如下： 

Option Explicit
Sub 汇总2()
     Dim i%, j%, f$, k%, n%, m%
     Dim wb As Workbook, sht As Worksheet
     Dim d As Object, s
     Dim arr, arr1()
     Set d = CreateObject("scripting.dictionary")
      s = Timer
      f = Dir(ThisWorkbook.Path & "\*test*.xlsx")
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Do While f <> ""
               Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
               For Each sht In Worksheets
                         sht.Activate
                         i = [a100000].End(3).Row
                         arr = Range("A3:D" & i)
                         For k = 1 To UBound(arr)
                         If Not d.exists(arr(k, 1) & arr(k, 2) & arr(k, 3)) Then
                              n = n + 1
                              d(arr(k, 1) & arr(k, 2) & arr(k, 3)) = n
                              ReDim Preserve arr1(1 To 4, 1 To n) '必须重新定义数组的维度
                              arr1(1, n) = arr(k, 1)
                              arr1(2, n) = arr(k, 2)
                              arr1(3, n) = arr(k, 3)
                              arr1(4, n) = arr(k, 4)
                              m = d(arr(k, 1) & arr(k, 2) & arr(k, 3))
                              arr1(4, m) = arr1(4, m) + arr(k, 4)
                         End If
                         Next k
                         Erase arr
               Next sht
               wb.Close False
     f = Dir
              Range("A2").Resize(d.Count, 4) = Application.Transpose(arr1)
              Range("A1:D1") = Array("名称", "代号", "长度", "数量")
              ActiveWorkbook.Worksheets("汇总2-字典").Sort.SortFields.Clear
              ActiveWorkbook.Worksheets("汇总2-字典").Sort.SortFields.Add Key:=Range("A8"), _
              SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
              With ActiveWorkbook.Worksheets("汇总2-字典").Sort
                  .SetRange Range("A2:D10")
                  .Header = xlNo
                  .MatchCase = False
                  .Orientation = xlTopToBottom