Excel多工作表合并后添加流水号、CountA公式及分区标题需求

完整优化代码 #

Sub CombineSheetsWithSections()
    Dim wsCombine As Worksheet
    Dim wsSource As Worksheet
    Dim targetRow As Long
    Dim lastRow As Long
    Dim sectionTitle As String
    Dim dataStartRow As Long
    
    ' 检查并初始化Combine工作表
    On Error Resume Next
    Set wsCombine = ThisWorkbook.Worksheets("Combine")
    On Error GoTo 0
    If wsCombine Is Nothing Then
        Set wsCombine = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsCombine.Name = "Combine"
    Else
        wsCombine.Cells.Clear ' 清空原有内容
    End If
    
    targetRow = 1
    
    ' 遍历指定工作表进行合并
    For Each wsSource In ThisWorkbook.Worksheets
        Select Case wsSource.Name
            Case "DUTY FREE", "TLS", "Anntana"
                ' 添加分区标题
                sectionTitle = wsSource.Name & " 数据分区"
                With wsCombine.Cells(targetRow, 1)
                    .Value = sectionTitle
                    .Font.Bold = True
                    .Font.Size = 12
                End With
                targetRow = targetRow + 1
                
                ' 添加数据行统计（CountA公式）
                wsCombine.Cells(targetRow, 1).Value = "数据总行数："
                lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
                If lastRow >= 2 Then
                    wsCombine.Cells(targetRow, 2).Formula = "=COUNTA('" & wsSource.Name & "'!A2:A" & lastRow & ")"
                Else
                    wsCombine.Cells(targetRow, 2).Value = 0
                End If
                targetRow = targetRow + 2
                
                ' 复制源表数据
                wsSource.UsedRange.Copy wsCombine.Cells(targetRow, 1)
                dataStartRow = targetRow
                targetRow = targetRow + wsSource.UsedRange.Rows.Count
                
                ' 生成流水号（跳过表头行）
                If dataStartRow < targetRow - 1 Then
                    wsCombine.Cells(dataStartRow + 1, 1).Formula = "=ROW()-ROW(" & wsCombine.Cells(dataStartRow, 1).Address & ")"
                    wsCombine.Cells(dataStartRow + 1, 1).AutoFill _
                        Destination:=wsCombine.Range(wsCombine.Cells(dataStartRow + 1, 1), wsCombine.Cells(targetRow - 1, 1))
                    ' 可选：将公式转为固定值
                    ' wsCombine.Range(wsCombine.Cells(dataStartRow + 1, 1), wsCombine.Cells(targetRow - 1, 1)).Value = _
                    '     wsCombine.Range(wsCombine.Cells(dataStartRow + 1, 1), wsCombine.Cells(targetRow - 1, 1)).Value
                End If
                
                targetRow = targetRow + 2 ' 分区间空行分隔
        End Select
    Next wsSource
    
    wsCombine.Columns.AutoFit
    MsgBox "合并完成！", vbInformation
End Sub

核心功能实现说明 #

• 分区标题：为每个数据源表生成加粗的分区标识，明确数据归属。
• 数据统计：使用COUNTA公式自动计算源表有效数据行数（排除表头），公式关联源表，数据更新时统计值自动同步。
• 流水号：通过ROW()函数生成从1开始的连续流水号，批量填充至数据行，跳过表头。
• 工作表管理：自动创建或清空Combine工作表，避免重复数据干扰。
• 格式优化：用空行分隔不同数据分区，自动调整列宽提升可读性。

自定义调整点 #

• 若源表表头不在第1行，需修改lastRow计算逻辑及流水号起始行判断。
• 如需调整流水号列，将代码中所有1（列号）替换为目标列的数字（如3对应C列）。
• 可修改标题的字体、颜色等格式，匹配示例图样式。

内容的提问来源于stack exchange，提问作者NewLFC