Quote Originally Posted by ernsersaig View Post
Here's a VBA code that should accomplish this:
VB.Net
Sub InsertSection()

    Dim srcDoc As Document
    Dim tgtDoc As Document
    Dim srcRng As Range
    Dim tgtRng As Range
    Dim shp As Shape

    Const srcHeading As String = "3. SECTION HEADING EXAMPLE"
    Const tgtHeading As String = "2. SECTION HEADING EXAMPLE"

    For Each srcDoc In ActiveDocument.Parent.Documents
        srcDoc.Activate

        ' Find the source section based on the heading
        Set srcRng = srcDoc.Sections(1).Range
        While srcRng.Find.Execute(srcHeading)
            Set srcRng = srcRng.Find.Found
            Exit While
        End While

        ' Copy the entire section
        srcRng.Copy

        ' Find the target section in the target document
        Set tgtDoc = ActiveDocument
        Set tgtRng = tgtDoc.Sections(1).Range
        While tgtRng.Find.Execute(tgtHeading)
            Set tgtRng = tgtRng.Find.Found
            Exit While
        End While

        ' Paste the copied section after the target heading
        tgtRng.Collapse wdCollapseEnd
        tgtRng.Paste

        ' Copy any shapes within the section
        For Each shp In srcDoc.Shapes
            If shp.Range.Start >= srcRng.Start And shp.Range.End <= srcRng.End Then
                shp.Copy
                tgtDoc.Shapes.Paste
            End If
        Next shp

    Next srcDoc

End Sub
I entered your code but the system still reports an error, why?