下面提供VBA的另外一種寫法。您只需要打開自己需要合并的EXCEL，把代碼粘貼到visual basic編輯器中。代碼就會(huì)自動(dòng)將各個(gè)Sheet的內(nèi)容合并到一張表里。并且會(huì)新建一個(gè)EXCEL存在在該源文件的同級目錄下。命名采用日期+時(shí)間+匯總表的命名方式。如果源數(shù)據(jù)有變，重新合并一下就可以，沒有任何其他的條件。比較方便?？梢韵瓤聪挛忆浀膭?dòng)圖：
直接使用請粘貼如下的代碼：
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)建一個(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對象）
'返回值：無
'說明：將數(shù)據(jù)依次粘貼到目標(biāo)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
代碼貼上來真得好丑，強(qiáng)烈建議悟空問答優(yōu)化一下。。T T
