一、单文件多工作表合并

情况一：单文件多工作表合并，即在一张工作薄中，有多个工作表格，每个表格的内容都一致，只是所属的类别不同。现在要将所有类别表格里的内容全部合并到一张工作表格里。如以下表格（诺基亚零配件清单），一共有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]