目的：将工作簿下所有工作表合并到一个工作表中
这里有两种VBA代码可以实现：
方法一：
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
方法二：
Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
X = Range("A65536").End(xlUp).Row + 1
Sheets(j).UsedRange.Copy Cells(X, 1) '复制内容
End If
Next
Range("B1").Select '表明从B1单元格开始复制合并的内容
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"
End Sub
End Function
欢迎学习交流 | 如侵即删
