excel 批量合并多个sheet的数据

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

这里写了2个函数，

函数Creatworkbook创建新的EXCEL，存放合并后的数据。

函数MergeContent循环每一个Sheet，然后把内容复制到新创建的EXCEL中。

命名采用日期+时间+汇总表的命名方式。

如果源数据有变，重新运行一下代码就可以，没有任何其他的条件。

大家可以看一下动图：