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




Reply With Quote
