Найти, скопировать, переместить выделение с помощью Word VBA

Question

Я пробовал это в разные стороны, и это все еще проходит мимо закладки Конец.

Sub Macro3() 
    Dim rngStart As Range, rngEnd As Range 
    Set rngStart = ActiveDocument.Bookmarks("START").Range 
    Set rngEnd = ActiveDocument.Bookmarks("END").Range 
    Selection.SetRange rngStart.Start, rngEnd.End 
    Do 
        If Selection.Find.Found And Selection.Range.Start < rngEnd.End Then 'do your copy/moves ... 
        Else 
            Exit Sub 
        End If 
    Loop 
End Sub

У меня есть документ, который содержит повторяющуюся информацию, которую мне нужно найти и скопировать / переместить в конец документа. Я не хочу, чтобы он просматривал то, что было отправлено в конец документа. Я использовал следующий код; однако, он не останавливается, как только достигает закладки END. Помощь очень ценится.

Sub Macro3()
'
' Macro3 Macro
'

    Dim rngStart As Range, rngEnd As Range
    Set rngStart = ActiveDocument.Bookmarks("START").Range
    Set rngEnd = ActiveDocument.Bookmarks("END").Range

    Selection.SetRange rngStart.Start, rngEnd.End
    Do
        With Selection.Find
            .Forward = True
            .Execute FindText:="Flag"
            Selection.HomeKey Unit:=wdLine
            .Forward = False
            .Execute FindText:="IDR Date"
        End With
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Copy
        Selection.EndKey Unit:=wdStory
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
        Selection.TypeBackspace
        Selection.TypeText Text:=vbTab
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Forward = True
            .Execute FindText:="Flag"
        End With
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Cut
        Selection.EndKey Unit:=wdStory
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
        Selection.HomeKey Unit:=wdStory

        If Selection.Find.Found Then
            With Selection.Find
                .Forward = True
                .Execute FindText:="Flag"
                Selection.HomeKey Unit:=wdLine
                .Forward = False
                .Execute FindText:="IDR Date"
            End With
            Selection.MoveDown Unit:=wdLine, Count:=1
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.Copy
            Selection.EndKey Unit:=wdStory
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            Selection.TypeBackspace
            Selection.TypeText Text:=vbTab
            Selection.HomeKey Unit:=wdStory
            With Selection.Find
                .Forward = True
                .Execute FindText:="Flag"
            End With
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.Cut
            Selection.EndKey Unit:=wdStory
            Selection.PasteAndFormat (wdFormatOriginalFormatting)
            Selection.HomeKey Unit:=wdStory
        Else
            Exit Do
        End If
    Loop
End Sub

Answer 1

Ваш код не остановится, когда будет достигнута закладка "Конец", потому что у вас нет никакого теста для него. После каждого:

If Selection.Find.Found then

Вам нужно проверить начальное местоположение строки Found по сравнению с конечным местоположением закладки End, которая будет выглядеть примерно так:

If Selection.Find.Found and Selection.Range.Start < rngEnd.End then
       'do your copy/moves
   else
       Exit Sub
End If