利用VBA實現多個Excel工作簿快速合並方法

工具/原料

 

•  Excel
•  VBA

方法/步驟

 

1. 1

    為了便於演示，我在同一個文件夾下隨便建了幾個Excel文件（當然我們也可以合並不同文件夾下的Excel文檔），隨機輸了一些內容。另外建了一個名稱為匯總文件的xls文件，這是我們准備寫入代碼並匯總數據的Excel空文件。

   
2. 2

   雙擊打開匯總文件.xls(當然我們也可以隨便新建一個excel文檔）,按ALT+F11打開VBE編輯器,新建一個模塊,粘貼如下代碼：

   Option Explicit

   Sub mergeonexls() '合並多工作簿中指定工作表

   On Error Resume Next

   Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

   Dim t As Workbook, ts As Worksheet, l As Integer, h As Long

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

   x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

          Title:="Excel選擇", MultiSelect:=True)

   Set t = ThisWorkbook

   Set ts = t.Sheets(1) '指定合並到的工作表，這里是第一張工作表

   l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

   For Each x1 In x

   If x1 <> False Then

    Set w = Workbooks.Open(x1)

    Set wsh = w.Sheets(1) '指定所需合並工作表，這里是第一張工作表

    h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

    wsh.UsedRange.Copy ts.Cells(1, 1)

    Else

    wsh.UsedRange.Copy ts.Cells(h + 1, 1)

    End If

    w.Close

   End If

   Next

   Application.ScreenUpdating = True

   Application.DisplayAlerts = True

   End Sub

   Sub mergeeveryonexls() '將多個工作簿下的工作表依次對應合並到本工作簿下的工作表，即第一張工作表對應合並到第一張，第二張對應合並到第二張……

   On Error Resume Next

   Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet

   Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long

   Application.ScreenUpdating = False

   Application.DisplayAlerts = False

   x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

          Title:="Excel選擇", MultiSelect:=True)

   Set t = ThisWorkbook

   For Each x1 In x

   If x1 <> False Then

    Set w = Workbooks.Open(x1)

    For i = 1 To w.Sheets.Count

   If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)

    Set ts = t.Sheets(i)

    Set wsh = w.Sheets(i)

    l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column

    h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then

    wsh.UsedRange.Copy ts.Cells(1, 1)

    Else

    wsh.UsedRange.Copy ts.Cells(h + 1, 1)

    End If

    Next

    w.Close

   End If

   Next

   Application.ScreenUpdating = True

   Application.DisplayAlerts = True

   End Sub

    

   
3. 3

    單擊菜單：工具-宏-宏（或者ALT+F8），打開宏對話框。

   
4. 4

   我們先來看看多個Excel工作簿指定工作表快速合並（我這里是指定合並第一張工作表，可自行到代碼注釋部位更改指定的表）的實現：在宏對話框中運行名稱為：mergeonexls的宏，在彈出的Excel選擇對話框中選中book1-book3（當然你也可以隨便選擇一些需要合並的Excel文件），打開。

   
5. 5

    查看下效果，如下圖：

   
6. 6

    利用和上面相同的操作運行mergeeveryonexls宏，在彈出的Excel選擇對話框中選中book1-book3，打開。查看所有工作表依次合並的效果，可見不僅把book1-book3中sheet1-sheet3中的內容匯總，因為book1中還含有sheet4工作表，所以還新插入了一個工作表sheet4，匯總了book1中sheet4中的內容，如下圖。

   

   
7. 7

    演示文檔可至http://pan.baidu.com/s/1eQHgsXc處下載。