很多朋友會遇到這樣的問題，就是很有很多頁的資料，少的有幾十頁，多的可能有幾百頁，然後需要合併到一個頁面做資料分析，如果一頁頁的複製貼上的話，就比較麻煩。下面我就介紹一種利用excel的巨集計算來解決這個問題。

一、資料準備

二、合併效果

三、程式碼

       在Sheet1上右鍵→檢視程式碼，開啟程式碼編輯器，寫入如下內容：

Sub UnionSheets()
    Application.ScreenUpdating = False
    For i = 1 To Sheets.Count
       If Sheets(i).Name <> ActiveSheet.Name Then
           X = Range("A65536").End(xlUp).Row + 1   '獲取當前sheet中已有的行數，從+1行開始
           Sheets(i).UsedRange.Copy Cells(X, 1)    '往當前sheet中的Cells(X, 1)開始複製資料
       End If
    Next
    Range("A1").Select '選中第一個單元格（返回到頂部）
    Application.ScreenUpdating = True
    MsgBox "合併完畢！", vbInformation, "提示"
End Sub
 

Sub combo()
Dim Wk As Workbook, Sht As Worksheet, n As Integer, MyPath, MyName
Application.ScreenUpdating = False
Application.EnableEvents = False
n = 1
MyPath = ThisWorkbook.Path & "\"  '指定路徑
MyName = Dir(MyPath & "\" & "*.xls") '尋找第一項
Do While MyName <> ""   '開始迴圈
If MyName <> ThisWorkbook.Name Then
Set Wk = Workbooks.Open(MyPath & "\" & MyName)
Wk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '此處只插個第一個sheet
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Mid(MyName, 1, Len(MyName) - 4) '重新命名sheet
'For Each Sht In Wk.Sheets '多個sheet
'Sht.Name = Format(n, "000″)
'n = n + 1
'Next
Wk.Close False
End If
MyName = Dir    '查詢下一個
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub