下面提供VBA的另外一種寫法。您只需要打開自己需要合并的EXCEL，把代碼粘貼到visual basic編輯器中。代碼就會自動將各個Sheet的內(nèi)容合并到一張表里。并且會新建一個EXCEL存在在該源文件的同級目錄下。命名采用日期+時間+匯總表的命名方式。如果源數(shù)據(jù)有變，重新合并一下就可以，沒有任何其他的條件。比較方便?？梢韵瓤聪挛忆浀膭訄D：

直接使用請粘貼如下的代碼：

Sub Run()

Dim tar_wb As Workbook

Set tar_wb = CreateWorkbook

Call MergeContent(tar_wb)

End Sub

'函數(shù)名: CreateWorkbook

'接受參數(shù)：無

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

'說明：創(chuàng)建一個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對象）

'返回值：無

'說明：將數(shù)據(jù)依次粘貼到目標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

代碼貼上來真得好丑，強烈建議悟空問答優(yōu)化一下。。T T