Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
Set Rng = Selection.Characters.Last
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="LastEntryThusFarMadeInTblOfExhibits")
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Rng.Collapse wdCollapseEnd
Rng.End = .Range.End
With Rng
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[!^13]@[FULLNAME: PDF] "
.Style = "Heading 1"
.Font.Hidden = True
.Replacement.Text = ""
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
.Collapse wdCollapseStart
.Bookmarks.Add Name:="LastEntryThusFarMadeInTblOfExhibits", Range:=.Duplicate
End If
End With
End With
Application.ScreenUpdating = True
End Sub