單個工作薄Excel表的合并和表格含有多個工作薄Excel的合并

Excel作為辦公的最基本有軟體，當Excel有多個，想統一放到一個表裡面的時候，我們一般采用隻能一個一個的複制、粘貼；但是當有很多的表格時，相信就沒那麼容易了，不光浪費時間，還容易出錯，來回的切換就把自己搞暈了，現在教大家用VBA的方法來快速實作。

**首先，需要把要複制的檔案全部放到一個檔案夾裡面去**

第二，在此檔案夾下建立一個Excel表格，即上圖中的合并.xlsm,為可以執行宏檔案的表格檔案。合并表格這裡給出兩種方式：

**1.合并所有的EXCEL表中的Shee1表中的資料**

`Sub 合并所有的EXCEL表中的Shee1表中的資料()
Dim MyPath, MyName, AWbName As String
Dim Wb, AWB, HeB As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
Set AWB = ActiveWorkbook
AWbName = AWB.Name
MyPath = AWB.Path
MyName = Dir(MyPath & "\" & "*.xlsx")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
Dim N As Integer
N = Workbooks(1).Worksheets("sheet1").Cells.Range("A65536").End(xlUp).Row
'把目前工作表路徑下的xls檔案中的第1個工作薄複制到目前工作薄中的B列最後有資料的行數加1的單元格，列為A。
Wb.Sheets(1).UsedRange.Copy Workbooks(1).Worksheets("sheet1").Cells(N + 1, 1)

WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub`
           

**2.合并目前目錄下所有工作簿的全部工作表(表格中含有多個工作薄)**

Sub 合并目前目錄下所有工作簿的全部工作表()
    Dim MyPath, MyName, AWbName As string
    Dim Wb As Workbook, WbN As String
    Dim G As Long
    Dim Num As Long
    Dim BOX As String
    flag = 0
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    MyName = Dir(MyPath & "\" & "*.xls")
    AWbName = ActiveWorkbook.Name
    Num = 0
  
    Do While MyName <> ""
        
        If MyName <> AWbName Then
            
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
              Num = Num + 1
           '需要添加的工作表的表格的個數
            Dim Req_SheetCount As Integer
            Req_SheetCount = Sheets.Count
                
                '激活合并的工作表
                Workbooks(1).Activate
                
                  '合并的工作表的表格的個數
                 Dim A_SheetCount As Integer
                 A_SheetCount = Sheets.Count
                 
                 '當需要添加的工作表的表格的sheet個數大于合并的工作表的表格的sheet個數時，給合并的工作表的表格添加工作表格sheet
                 If Req_SheetCount > A_SheetCount Then
                    Sheets.Add after:=Sheets(A_SheetCount), Count:=(Req_SheetCount - A_SheetCount)
                  End If
                  
                 For G = 1 To Wb.Sheets.Count
                     
                    If flag = 0 Then
                    
                     '給相應sheet表重命名
                        With Worksheets(G)
                               .Name = Wb.Sheets(G).Name
                           Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row, 1)
                           .UsedRange.Rows.AutoFit
                           .UsedRange.Columns.AutoFit      
                        End With                   
                    Else
                          
                           With Worksheets(G)                         
                         Wb.Sheets(G).Range("a2", Wb.Sheets(G).Cells.SpecialCells(xlCellTypeLastCell)).Copy .Cells(.Range("A65536").End(xlUp).Row + 2, 1)
                        End With
                    End If
            Next
                'flag 為0時候為第一個打開的excel，此時産生列，sheet名
                 flag = 1
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
           ' End With
        End If
        MyName = Dir
    Loop
   
        Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub
           

運作以上代碼即可輕松實作表格的合并了。