excel怎麼快速合併多個工作表資料到一個工作表

1

原始資料所在工作簿包含多個格式相同的工作表，只不過每個工作表內容不同，比如說不同人名的工作表資料或者不同部門填寫的資料。

2

在原始資料同目錄下新建一個工作簿，建立兩個工作表，名稱分別為「首頁」和「合併彙總表」。

3

按Alt+F11進入VBA程式碼編輯和偵錯介面。

4

根據下圖提示，插入一個模組。

5

將下述程式碼貼上到模組空白處：

Sub CombineSheetsCells()

    Dim wsNewWorksheet As Worksheet

    Dim cel As Range

    Dim DataSource, RowTitle, ColumnTitle, SourceDataRows, SourceDataColumns As Variant

    Dim TitleRow, TitleColumn As Range

    Dim Num As Integer

    Dim DataRows As Long

    DataRows = 1

    Dim TitleArr()

    Dim Choice

    Dim MyName$, MyFileName$, ActiveSheetName$, AddressAll$, AddressRow$, AddressColumn$, FileDir$, DataSheet$, myDelimiter$

    Dim n, i

    n = 1

    i = 1

    Application.DisplayAlerts = False

    Worksheets("合併彙總表").Delete

    Set wsNewWorksheet = Worksheets.Add(, after:=Worksheets(Worksheets.Count))

    wsNewWorksheet.Name = "合併彙總表"

    MyFileName = Application.GetOpenFilename("Excel工作薄 (*.xls*),*.xls*")

    If MyFileName = "False" Then

        MsgBox "沒有選擇檔案！請重新選擇一個被合併檔案！", vbInformation, "取消"

    Else

        Workbooks.Open Filename:=MyFileName

        Num = ActiveWorkbook.Sheets.Count

        MyName = ActiveWorkbook.Name

        Set DataSource = Application.InputBox(prompt:="請選擇要合併的資料區域：", Type:=8)

        AddressAll = DataSource.Address

        ActiveWorkbook.ActiveSheet.Range(AddressAll).Select

        SourceDataRows = Selection.Rows.Count

        SourceDataColumns = Selection.Columns.Count

        Application.ScreenUpdating = False

        Application.EnableEvents = False

        For i = 1 To Num

            ActiveWorkbook.Sheets(i).Activate

            ActiveWorkbook.Sheets(i).Range(AddressAll).Select

            Selection.Copy

            ActiveSheetName = ActiveWorkbook.ActiveSheet.Name

            Workbooks(ThisWorkbook.Name).Activate

            ActiveWorkbook.Sheets("合併彙總表").Select

            ActiveWorkbook.Sheets("合併彙總表").Range("A" & DataRows).Value = ActiveSheetName

            ActiveWorkbook.Sheets("合併彙總表").Range(Cells(DataRows, 2), Cells(DataRows, 2)).Select

            Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

                                   SkipBlanks:=False, Transpose:=False

            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

                                                                                     False, Transpose:=False

            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

                                                                            :=False, Transpose:=False

            DataRows = DataRows + SourceDataRows

            Workbooks(MyName).Activate

        Next i

        Application.ScreenUpdating = True

        Application.EnableEvents = True

    End If

    Workbooks(MyName).Close

End Sub

6

在「首頁」工作表中按下圖示範插入一個表單控制元件並指定巨集為插入的程式碼名稱。

7

點選「首頁」工作表中插入的按鈕，根據提示，瀏覽到原始資料工作簿。

8

下一步，用滑鼠選擇要合併的資料範圍。

注意：每個工作表資料可能不一樣，比如說有的是10行資料，有的是30行資料。在這裡我們可以用滑鼠選擇任意工作表的一個較大範圍，比如說A1:D100，保證比最多行數的工作表資料還多就可以，一會再刪除空行。

9

點選確定按鈕，待程式碼執行完畢後，所有的資料就都合併到了「合併彙總表」中。

注意：

1）A列的文字說明右側的資料來自於原始資料表的哪個工作表；

2）資料之間會有一些空行，下面通過篩選刪除。

10

選中全部資料區域，執行自動篩選。然後選擇其中一個欄位，選擇「空白」和標題內容。

11

然後將篩選出來的無用行滑鼠右鍵刪除，再刪除A列整列即可，完成效果如下圖：