悟空问答

下面提供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

代码贴上来真得好丑，强烈建议悟空问答优化一下。。T T