表格中有多个工作表，现在需要按照第 1~6 行的标题，对工作表中的数据进行合并汇总。 请你写一个 VBA 代码完成数据的合并，要求如下： 1. 1~6 行的标题，不要重复的合并标题 2. 合并时，第 1 列写入工作表的名称，方便了解数据来源
Sub MergeSheetsWithSource()Dim wsSummary As WorksheetDim ws As WorksheetDim lastRow As LongDim summaryRow As LongDim headerCopied As BooleanDim i As Integer' 创建汇总表Set wsSummary = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))wsSummary.Name = "汇总数据"' 初始化标志headerCopied = FalsesummaryRow = 1Application.ScreenUpdating = False' 遍历所有工作表For Each ws In ThisWorkbook.SheetsIf ws.Name <> wsSummary.Name Then ' 跳过汇总表' 处理标题行（1-6 行）If Not headerCopied Then' 添加数据来源列ws.Rows("1:6").CopywsSummary.Cells(summaryRow, 1).PasteSpecial xlPasteAllwsSummary.Cells(1, 1).Value = "数据来源"' 调整列位置wsSummary.Columns(1).Insert Shift:=xlToRightsummaryRow = 7 ' 跳过标题行headerCopied = TrueEnd If' 处理数据行（从第 7 行开始）lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).RowIf lastRow >= 7 ThenDim dataRange As RangeSet dataRange = ws.Range("A7:Y" & lastRow)' 复制数据并添加来源dataRange.CopywsSummary.Cells(summaryRow, 2).PasteSpecial xlPasteValues' 添加工作表名称到第一列wsSummary.Range(wsSummary.Cells(summaryRow, 1), _wsSummary.Cells(summaryRow + dataRange.Rows.Count - 1, 1)) = ws.NamesummaryRow = summaryRow + dataRange.Rows.CountEnd IfEnd IfNext ws' 格式整理With wsSummary.Columns(1).ColumnWidth = 20.Columns(2).ColumnWidth = 15.Rows("1:6").Font.Bold = True.Cells(1, 1).EntireRow.Insert ' 添加标题分隔行End WithApplication.CutCopyMode = FalseApplication.ScreenUpdating = TrueMsgBox "数据合并完成！共合并 " & summaryRow - 7 & " 行数据", vbInformationEnd Sub
