下面提供VBA的另外一種寫法。您只需要打開(kāi)自己需要合并的EXCEL，把代碼粘貼到visual basic編輯器中。代碼就會(huì)自動(dòng)將各個(gè)Sheet的內(nèi)容合并到一張表里。并且會(huì)新建一個(gè)EXCEL存在在該源文件的同級(jí)目錄下。命名采用日期+時(shí)間+匯總表的命名方式。如果源數(shù)據(jù)有變，重新合并一下就可以，沒(méi)有任何其他的條件。比較方便。可以先看下我錄的動(dòng)圖：

直接使用請(qǐng)粘貼如下的代碼：

Sub Run()

Dim tar_wb As Workbook

Set tar_wb = CreateWorkbook

Call MergeContent(tar_wb)

End Sub

'函數(shù)名: CreateWorkbook

'接受參數(shù)：無(wú)

'返回值：Workbook（返回創(chuàng)建的Workbook）

'說(shuō)明：創(chuàng)建一個(gè)Excel文件，存放合并的數(shù)據(jù)

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

'函數(shù)名: MergeContent

'接受參數(shù)：targetWorkbook（合并后的數(shù)據(jù)存放的Workbook對(duì)象）

'返回值：無(wú)

'說(shuō)明：將數(shù)據(jù)依次粘貼到目標(biāo)Workbook對(duì)象、即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

代碼貼上來(lái)真得好丑，強(qiáng)烈建議悟空問(wèn)答優(yōu)化一下。。T T