如何用VBA将Excel主表按标题分隔的数据块复制到对应工作表

Sub FormatExcel()
    Dim masterSht As Worksheet
    Dim LR As Long, i As Long
    Dim titleMap As Object
    Dim targetShtName As String
    Dim dataRng As Range
    
    ' 初始化标题和对应工作表名的映射字典，新增匹配规则直接在这里加键值对即可
    Set titleMap = CreateObject("Scripting.Dictionary")
    titleMap("All Call Distribution by Queue") = "All Calls by Queue"
    titleMap("Unanswered Service Level") = "Unanswered Service Level"
    ' 剩余13组标题和表名对应关系按上面格式继续添加即可
    
    Set masterSht = ThisWorkbook.Sheets("Master")
    LR = masterSht.Range("A" & masterSht.Rows.Count).End(xlUp).Row
    
    For i = 1 To LR
        ' 仅判断A列非空单元格是否是目标标题
        If masterSht.Range("A" & i).Value <> "" Then
            If titleMap.Exists(masterSht.Range("A" & i).Value) Then
                targetShtName = titleMap(masterSht.Range("A" & i).Value)
                ' 工作表不存在则直接跳过，避免报错
                If SheetExists(targetShtName) Then
                    ' 获取当前标题对应的完整数据块
                    Set dataRng = masterSht.Range("A" & i).CurrentRegion
                    ' 偏移1行去掉标题后，直接复制到目标工作表，无需选中操作
                    dataRng.Offset(1, 0).Resize(dataRng.Rows.Count - 1).Copy _
                        Destination:=ThisWorkbook.Sheets(targetShtName).Range("A1")
                    ' 如果需要剪切原数据，把上面的Copy改成Cut即可
                End If
                ' 跳过当前数据块所有行，避免无意义循环
                i = i + dataRng.Rows.Count
            End If
        End If
    Next
    ' 清空剪贴板
    Application.CutCopyMode = False
End Sub

' 自定义函数：判断指定名称的工作表是否存在
Function SheetExists(shtName As String) As Boolean
    Dim sht As Worksheet
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

• 解决粘贴多空白行问题：原代码使用ActiveCell定位单元格，循环过程中ActiveCell不会随遍历行自动跳转，导致频繁选中错误区域；优化后直接通过匹配到的标题单元格获取数据块，偏移1行过滤掉标题本身，彻底避免多余空行和冗余内容
• 新增工作表存在性校验：通过自定义SheetExists函数判断目标工作表是否存在，不存在则直接跳过对应操作，不会抛出运行错误
• 简化多标题匹配逻辑：用字典存储标题和对应工作表的映射关系，新增匹配规则只需要在字典初始化部分加一行键值对即可，不需要重复复制粘贴业务逻辑代码
• 移除所有Select/Active相关操作：避免录制宏带来的效率低、定位不准问题，运行速度更快更稳定
• 新增循环跳转逻辑：匹配到一个数据块后直接跳过该块所有行，不需要逐行循环无意义内容，提升运行效率

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