通過VBA宏合并Excel工作表

工作中經常會用到的把幾個Excel檔案合并到一個，或者是把一個Excel檔案裡的所有Sheet合并到一個Sheet來進行統計。下面分别提供用vba宏來解決這兩個問題的方法。

1、合并Excel檔案

打開一個空Excel檔案，Alt+F11，插入一個子產品，開始寫代碼：

Sub MergeWorkbooks()

   Dim FileSet

   Dim i As Integer

   On Error GoTo 0

   Application.ScreenUpdating = False

   FileSet = Application.GetOpenFilename(FileFilter:="Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx", _

                                           MultiSelect:=True, Title:="選擇要合并的檔案")

   If TypeName(FileSet) = "Boolean" Then

       GoTo ExitSub

   End If

   For Each Filename In FileSet

       Workbooks.Open Filename

       Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

   Next

ExitSub:

   Application.ScreenUpdating = True

End Sub

這段代碼的作用：它首先打開一個檔案選擇框，你可以選擇一個或多個檔案，然後把這些檔案裡的所有Sheet合并到目前這個工作簿裡來，有重名的Sheet會自動在後面加數字。

2、合并一個EXCEL多個sheet的内容到一個彙總sheet

同上，再添加一個子產品吧，代碼如下：

Function LastRow(sh As Worksheet)

   On Error Resume Next

   LastRow = sh.Cells.Find(what:="*", _

                           After:=sh.Range("A1"), _

                           Lookat:=xlPart, _

                           LookIn:=xlFormulas, _

                           SearchOrder:=xlByRows, _

                           SearchDirection:=xlPrevious, _

                           MatchCase:=False).Row

End Function

Sub MergeSheets()

   Dim sh As Worksheet

   Dim DestSh As Worksheet

   Dim Last As Long

   Dim shLast As Long

   Dim CopyRng As Range

   Dim StartRow As Long

   Application.EnableEvents = False

   '建立一個“彙總”工作表

   Application.DisplayAlerts = False

   ActiveWorkbook.Worksheets("彙總").Delete

   Application.DisplayAlerts = True

   Set DestSh = ActiveWorkbook.Worksheets.Add

   DestSh.Name = "彙總"

   '開始複制的行号，忽略表頭，無表頭請設定成1

   StartRow = 2

   For Each sh In ActiveWorkbook.Worksheets

       If sh.Name <> DestSh.Name Then

           Last = LastRow(DestSh)

           shLast = LastRow(sh)

           If shLast > 0 And shLast >= StartRow Then

               Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

               If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then

                   MsgBox "内容太多放不下啦！"

                   GoTo ExitSub

               End If

               CopyRng.Copy

               With DestSh.Cells(Last + 1, "A")

                   .PasteSpecial xlPasteValues

                   .PasteSpecial xlPasteFormats

                   Application.CutCopyMode = False

               End With

           End If

       End If

   Application.GoTo DestSh.Cells(1)

   DestSh.Columns.AutoFit

   Application.EnableEvents = True

這段代碼的作用：它會建立一個叫做“彙總”的工作表，然後把目前工作簿裡的所有Sheet裡有資料的内容都複制到“彙總”表裡。提示：如果資料表裡的内容沒有表頭的話需要把StartRow = 2改成StartRow = 1。