這個問題使用vba就很好處理了，10秒可以彙總幾百個表沒有問題的。

附上程式碼如下，直接可以使用。

Sub Allcopy()

Dim rg As Range

Dim sh As Worksheet

Dim irow, jcol

Sheets("總表").Range("2:1048576").Clear

For Each sh In Worksheets

With Sheets("總表")

If sh.Name <> "總表" Then

Set rg = sh.UsedRange.Offset(1, 0)

irow = .Range("A" & Rows.Count).End(xlUp).Row + 1

rg.Copy .Cells(irow, 1)

End If

End With

Next

end sub

下面提供VBA的另外一種寫法。您只需要開啟自己需要合併的EXCEL，把程式碼貼上到visual basic編輯器中。程式碼就會自動將各個Sheet的內容合併到一張表裡。並且會新建一個EXCEL存在在該原始檔的同級目錄下。命名採用日期+時間+彙總表的命名方式。如果源資料有變，重新合併一下就可以，沒有任何其他的條件。比較方便。可以先看下我錄的動圖：

直接使用請貼上如下的程式碼：

Sub Run()

Dim tar_wb As Workbook

Set tar_wb = CreateWorkbook

Call MergeContent(tar_wb)

End Sub

"函式名: CreateWorkbook

"接受引數：無

"返回值：Workbook（返回建立的Workbook）

"說明：建立一個Excel檔案，存放合併的資料

Private Function CreateWorkbook() As Workbook

Dim fileName As String

Dim filePath As String

Dim nowDate As String

nowDate = CDate(Now())

nowDate = Replace(nowDate, ":", "")

nowDate = Replace(nowDate, "/", "")

nowDate = Replace(nowDate, " ", "_")

filePath = ThisWorkbook.path & "\"

fileName = filePath & nowDate & "_彙總表.xlsx"

Dim newBook As Workbook

Set newBook = Workbooks.Add

With newBook

.SaveAs fileName

End With

Set CreateWorkbook = newBook

End Function

"函式名: MergeContent

"接受引數：targetWorkbook（合併後的資料存放的Workbook物件）

"返回值：無

"說明：將資料依次貼上到目標Workbook物件、即EXCEL中。

Private Function MergeContent(targetWorkbook As Workbook)

Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 1).End(xlToRight)).Copy targetWorkbook.Sheets("Sheet1").Range("A65536").End(xlUp)

For Each sht In ThisWorkbook.Worksheets

sht.Range("A1").CurrentRegion.Offset(1, 0).Copy targetWorkbook.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)

Next

targetWorkbook.Close True

End Function