Consulting

Results 1 to 8 of 8

Thread: How to Insert Section from Source Doc into Target Doc

  1. #1

    Question How to Insert Section from Source Doc into Target Doc

    Hello all,

    I am looking for help inserting a full section from a source doc into a target document.

    For example:

    "3. SECTION HEADING EXAMPLE
    3.1 Text here
    3.2 Text here
    3.3 Text here
    Table here:
    Table Heading Text
    Text Text
    Image Image
    3.4 Text here"

    I need the section from the source document to be pasted into a specific area in the target document, for example, between "2. SECTION HEADING EXAMPLE" and "4. SECTION HEADING EXAMPLE"

    I know this is possible because I used a code that did this previously but I cannot find it. I have a code that this sub will be inserted into that loops through all documents in a folder and performs a subroutine -- it will open all documents in a folder, perform the action, and close the document. All the documents need this specific section added between existing Section X and Y.

    Thank you for any help you can provide!

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,236
    Location
    Welcome to VBAX iwritedoc62. Until one of the word guru's drops by, perhaps this will get you started in the right direction

    Sub InsertAfterMethod()
      Dim MyText As String
      Dim MyRange As Object
      Set MyRange = ActiveDocument.Range
      MyText = "<Replace this with your text>"
      ' Selection Example:
      Selection.InsertAfter (MyText)
      ' Range Example:
      ' (Inserts text at the current position of the insertion point.)
      MyRange.Collapse
      MyRange.InsertAfter (MyText)
    End Sub


    Yes, it doesn't loop through your documents, but if you wish to test it and see if it can be modified.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    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

  4. #4
    bro, the post was made 4 months ago..

  5. #5
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,236
    Location
    Quote Originally Posted by arnelgp View Post
    bro, the post was made 4 months ago..
    Welcome to VBAX ernsersaig. Thank you for your contribution. Pay no attention to arnelgp's post.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    VBAX Newbie
    Joined
    Oct 2024
    Location
    https://geometry-dashscratch.com
    Posts
    1
    Location
    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?

  7. #7
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,236
    Location
    Quote Originally Posted by margaret16 View Post
    I entered your code but the system still reports an error, why?
    Simply because the system was designed to report the error. If you were asking about a particular error in the code supplied, then it would be more helpful, if you indicated the actual error being shown.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  8. #8
    VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,442
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •