求基于两行空行拆分SAP导出Excel大型报表至独立工作表的方案

以下是适配你需求的VBA解决方案，可按两行连续空行或子报表首尾标识（PersNr开头、** Summ结尾）自动拆分大型报表到独立工作表：

Sub SplitSAPReport()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim startRow As Long, endRow As Long
    Dim i As Long
    Dim sheetCounter As Integer
    
    ' 指定源工作表（可修改为实际报表表名，比如Sheets("SAP原始报表")）
    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
    startRow = 1
    sheetCounter = 1
    
    ' 遍历行寻找拆分节点
    For i = 1 To lastRow
        ' 识别两行连续空行的拆分点
        If wsSource.Cells(i, 1).Value = "" And wsSource.Cells(i + 1, 1).Value = "" Then
            endRow = i - 1
            If endRow >= startRow Then
                ' 创建新工作表并复制数据
                Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsNew.Name = "子报表" & sheetCounter
                wsSource.Rows(startRow & ":" & endRow).Copy Destination:=wsNew.Rows(1)
                sheetCounter = sheetCounter + 1
            End If
            ' 跳过空行，设置下一个子报表起始行
            startRow = i + 2
            i = i + 1
        ' 识别子报表结尾标识** Summ
        ElseIf wsSource.Cells(i, 1).Value = "** Summ" Then
            endRow = i
            ' 创建新工作表并复制数据
            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsNew.Name = "子报表" & sheetCounter
            wsSource.Rows(startRow & ":" & endRow).Copy Destination:=wsNew.Rows(1)
            sheetCounter = sheetCounter + 1
            ' 跳过结尾后的空行，定位下一个子报表起始行
            Do While wsSource.Cells(i + 1, 1).Value = "" And i < lastRow
                i = i + 1
            Loop
            startRow = i + 1
        End If
        
        ' 处理最后一个子报表，避免循环结束后遗漏
        If i = lastRow And startRow <= lastRow Then
            Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsNew.Name = "子报表" & sheetCounter
            wsSource.Rows(startRow & ":" & lastRow).Copy Destination:=wsNew.Rows(1)
        End If
    Next i
    
    MsgBox "拆分完成，共生成" & sheetCounter - 1 & "个子报表工作表。"
End Sub

代码说明 #

• 源表适配：默认使用当前激活的工作表，可手动修改wsSource = ActiveSheet为指定报表表名
• 双规则兼容：同时支持两行空行拆分和子报表首尾标识拆分，避免单一规则失效
• 数据完整性：完整复制子报表的所有行（含格式、公式），保留原报表样式
• 自动命名：新工作表按子报表1/2/3命名，可按需修改命名规则

使用步骤 #

1. 打开包含SAP报表的Excel文件
2. 按下Alt + F11打开VBA编辑器
3. 右键点击左侧工程窗口的工作簿名称 → 插入 → 模块
4. 将上述代码粘贴到模块中
5. 返回Excel，按下Alt + F8，选择SplitSAPReport宏执行

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