目的：将工作簿下所有工作表合并到一个工作表中
这里有两种VBA代码可以实现：
方法一：
Sub Run()Dim tar_wb As WorkbookSet tar_wb = CreateWorkbookCall MergeContent(tar_wb)End Sub'函数名: CreateWorkbook'接受参数：无'返回值：Workbook（返回创建的Workbook）'说明：创建一个Excel文件 ， 存放合并的数据Private Function CreateWorkbook() As WorkbookDim fileName As StringDim filePath As StringDim nowDate As StringnowDate = CDate(Now())nowDate = Replace(nowDate, ":", "")nowDate = Replace(nowDate, "/", "")nowDate = Replace(nowDate, " ", "_")filePath = ThisWorkbook.Path & ""fileName = filePath & nowDate & "_汇总表.xlsx"Dim newBook As WorkbookSet newBook = Workbooks.AddWith newBook.SaveAs fileNameEnd WithSet CreateWorkbook = newBookEnd 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.Worksheetssht.Range("A1").CurrentRegion.Offset(1, 0).Copy _targetWorkbook.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)NexttargetWorkbook.Close True
方法二：
Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.CountIf Sheets(j).Name <> ActiveSheet.Name ThenX = Range("A65536").End(xlUp).Row1Sheets(j).UsedRange.Copy Cells(X, 1) '复制内容End IfNextRange("B1").Select '表明从B1单元格开始复制合并的内容Application.ScreenUpdating = TrueMsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"End SubEnd Function
【Excel技巧 | VBA 合并当前工作簿下所有工作表】欢迎学习交流 | 如侵即删