如何修改Word VBA代码以复制所有Start与End标记之间的内容

Sub CopyAllSummary()
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim docNew As Document
    ' 提前创建新文档用于存放所有提取的内容
    Set docNew = Documents.Add
    
    Selection.HomeKey Unit:=wdStory
    
    Do
        With Selection.Find
            .ClearFormatting
            .Wrap = wdFindStop
            .MatchCase = False
            .Text = "Start"
            ' 找不到下一个Start标记就退出循环
            If .Execute = False Then Exit Do
            
            Selection.Collapse Direction:=wdCollapseEnd
            lngStart = Selection.End
            
            .Text = "End"
            If .Execute = False Then
                MsgBox "找到Start标记但未匹配到对应的End标记，已终止运行", vbExclamation
                Exit Sub
            End If
            lngEnd = Selection.Start
        End With
        
        ' 复制当前区间内容，追加到新文档末尾
        ActiveDocument.Range(lngStart, lngEnd).Copy
        docNew.Content.InsertParagraphAfter ' 不同区间内容之间加空行分隔，不需要可以删掉这行
        docNew.Range(docNew.Content.End - 1).Paste
        
        ' 把光标移动到当前End标记之后，继续查找下一组
        Selection.Collapse Direction:=wdCollapseEnd
    Loop

    MsgBox "所有区间内容提取完成", vbInformation
End Sub

• 新增Do Loop循环逻辑：每次成功提取一组内容后，自动从当前End标记的位置继续向后查找下一个Start标记，直到遍历完全部文档内容
• 调整新文档创建逻辑：提前创建新文档，每次提取到内容就追加到文档末尾，避免覆盖之前的提取结果
• 新增区间分隔逻辑：默认在不同提取区间之间加空行分隔，不需要可以自行删除docNew.Content.InsertParagraphAfter这行
• 优化异常提示：当存在无匹配End的Start标记时，给出明确提示避免程序无响应

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