一、单文件多工作表合并

情况一：单文件多工作表合并，即在一张工作薄中，有多个工作表格，每个表格的内容都一致，只是所属的类别不同。现在要将所有类别表格里的内容全部合并到一张工作表格里。如以下表格（诺基亚零配件清单），一共有200多种型号，每种型号一个清单，现在要将它们全部合并到一张工作表格里。

二、情况一解决方案

解决方案：插入一张工作表格，命名为“汇总”。按Alt+F11，进入VBA编辑器，写上如下代码：

Option Explicit

' 后面要用的，开始粘贴的行号
Private beginRowNo As Long

' 此过程启动汇总
Private Sub CommandButton1_Click()
    Dim sheetCount As Integer
    sheetCount = ThisWorkbook.Worksheets.Count
    
    Dim i As Integer
    beginRowNo = 1
    ' 以下循环遍历每个表格，将需要汇总的表格里的内容一一粘贴到“汇总”表格里
    For i = 1 To sheetCount
        Dim sheetName As String
        sheetName = ThisWorkbook.Worksheets(i).Name
        
        Select Case LCase(sheetName)
            Case "summary":
                MsgBox "跳过 " + sheetName
            Case "update record":
                MsgBox "跳过 " + sheetName
            Case "汇总":
                MsgBox "跳过 " + sheetName
            Case Else:
                DoSubtotal (sheetName)
        End Select
    Next i
End Sub

' 此过程用来将指定表格名称的表格内容，复制粘贴到“汇总”表格里。
Private Sub DoSubtotal(ByVal sheetName As String)
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    
    Set sourceSheet = ThisWorkbook.Worksheets(sheetName)
    Set destSheet = ThisWorkbook.Worksheets("汇总")
    
    sourceSheet.UsedRange.Copy 'destSheet.Range("A" & beginrowno)
    destSheet.Range("A" & beginRowNo).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, True
    beginRowNo = beginRowNo + sourceSheet.UsedRange.Rows.Count
    
    Set sourceSheet = Nothing
    Set destSheet = Nothing
End Sub

然后，将光标放置在 CommandButton1_Click 过程中的任意位置，按F5运行即可。

三、多文件合并

情况二：多文件合并，即在一个文件夹里，有多个工作薄文件，它们的第一个表格里的内容形式都一样，现在要将它们全部合并到一个工作薄里。如一个文件夹内，有每天的订单Excel文件，现在要将全部订单数据合并到一个Excel文件内。

四、多文件合并解决方案

解决方案：新建一个Excel工作薄，按Alt+F11，进入VBA编辑器，输入如下代码：

Sub 合并工作簿()
    Dim FilesToOpen
    Dim x As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Dim currentWorkSheet As Worksheet
    Dim rng As Range
    Set currentWorkSheet = ActiveWorkbook.ActiveSheet
    Set rng = currentWorkSheet.Range("A1")
    Dim wkb As Workbook
    Dim wks As Worksheet
    ' 以下循环分别将每个工作薄中的第一个工作表里的内容，复制粘贴到当前工作薄的第一张工作表里。
    While x <= UBound(FilesToOpen)
        Set wkb = Workbooks.Open(Filename:=FilesToOpen(x))
        Set wks = wkb.Worksheets(1)
        
        rng.Offset(0, 10).Value = wkb.Name
        
        wks.UsedRange.Copy rng
        
        Set rng = rng.Offset(wks.UsedRange.Rows.Count, 0)
        wkb.Close False
        
        x = x + 1
    Wend
    Set wks = Nothing
    Set rng = Nothing
    Set wkb = Nothing
    Set currentWorkSheet = Nothing

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

将光标放在过程“合并工作薄”的任意位置，按F5运行，在弹出的打开文件框中，选择需要合并的全部文件，确定即可。

五、多文件合并之二

情况三：多文件合并。类似情况二，但是，只将多个工作薄里的工作表复制到同一个工作薄里，不需要到同一个工作表。

六、多文件合并之二的解决方案

解决方案：类似情况二，代码只有一点点区别：

Sub 合并工作簿2()
    Dim FilesToOpen
    Dim x As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    ' 主要就是这里，这个循环处理代码与情况二稍有不同！
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        
        Sheets().Move After:=ThisWorkbook.Sheets _
          (ThisWorkbook.Sheets.Count)
          
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

注：如果先做情况三，再做情况一，那么就等于情况二。

[donate: www.zizhujy.com]