That code is pretty awful. Try:
Sub XferHeadingRange()Application.ScreenUpdating = False
Dim DocSrc As Document, RngSrc As Range
Dim DocTgt As Document, RngTgt As Range
Set DocTgt = ActiveDocument
With Application.Dialogs(wdDialogFileOpen)
If .Show = -1 Then
.AddToMru = False
.ReadOnly = True
.Visible = False
.Update
Set DocSrc = ActiveDocument
End If
End With
If DocSrc Is Nothing Then Exit Sub
With DocSrc.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "SOURCE SECTION HEADING EXAMPLE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
.Execute
End With
If .Find.Found = True Then
Set RngSrc = .Paragraphs(1).Range
Set RngSrc = RngSrc.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Else
MsgBox "Source Content Not Found!", vbExclamation
GoTo CleanUp
End If
End With
With DocTgt.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "TARGET SECTION HEADING EXAMPLE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
.Execute
End With
If .Find.Found = True Then
Set RngTgt = .Paragraphs(1).Range
RngTgt.Collapse wdCollapseStart
RngTgt.FormattedText = RngSrc.FormattedText
Else
MsgBox "Destination Not Found!", vbExclamation
End If
End With
: CleanUp
DocSrc.Close SaveChanges:=False
Set RngSrc = Nothing: Set DocSrc = Nothing
Set RngTgt = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub
Note: The code assumes the target document is already open and that Word's Heading Styles are used in the source document to denote the various ranges. When running the macro, you select the source document to open from the dialog box. For the target document, the heading to specify is the one after the location where you want the source content inserted.