Copy certain contents from document to another at specific section

Question

I want to copy a certain section (e.g. subject of the document then main body) to another Word document. The documents have different formatting so I need to copy to a predetermined location in the document.

The code below copies the whole of the source document to the target document.

Sub CopyPaste()
    Dim Word As New Word.Application
    Dim WordDoc As New Word.Document    'active document
    Dim WordDoc1 As New Word.Document   'document to extract from
    Dim dialogBox As FileDialog
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Dim Dest_path As String
    
    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file to copy from"
    
    'Show the file path and file name
    If dialogBox.Show = -1 Then
        MsgBox "You have selected: " & dialogBox.SelectedItems(1)
    End If
        
    ' Starts extracting from source document
    Set WordDoc1 = Word.Documents.Open(dialogBox.SelectedItems(1), ReadOnly:=True)
    Application.Browser.Target = wdBrowseSection
    For i = 1 To ((WordDoc1.Sections.Count) - 1)
        WordDoc1.Bookmarks("\Section").Range.Copy
    
        'Paste into an active document
        ActiveDocument.Bookmarks("\Section").Range.PasteAndFormat wdFormatOriginalFormatting
        WordDoc.ActiveWindow.Visible = True
        WordDoc1.Close
    Next i
End Sub

macropod macropod · Accepted Answer · 2020-11-16T12:00:53

Since you're apparently running this from Word with an activedocument, you really don't want any of:

Dim Word As New Word.Application
Dim WordDoc As New Word.Document    'active document
Dim WordDoc1 As New Word.Document   'document to extract from

since that starts a new Word session and two new empty Word documents before you even get to the dialog.

As for:

.Bookmarks("\Section")

that only works in code like:

Set Rng = ActiveDocument.GoTo(What:=wdGoToSection, Name:=i)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\section")

Try something along the lines of:

Sub Replicate()
Dim DocSrc As Document, RngSrc As Range
Dim DocTgt As Document, RngTgt As Range
With Application.FileDialog(msoFileDialogOpen)
  .AllowMultiSelect = False
  .Title = "Select a file for content replication"
  'Show the file path and file name
  If .Show = -1 Then
    MsgBox "You have selected: " & .SelectedItems(1)
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, Visible:=False)
  Else: Exit Sub
  End If
End With
Set DocTgt = ActiveDocument
' Starts extracting from source document
For i = 1 To ((DocSrc.Count) - 1)
  Set RngTgt = DocTgt.Sections(i).Range
  RngTgt.End = RngTgt.End - 1
  Set RngSrc = DocSrc.Sections(i).Range
  RngSrc.End = RngSrc.End - 1
  RngTgt.FormattedText = RngSrc.FormattedText
Next i
DocSrc.Close False
End Sub

Copy certain contents from document to another at specific section

1 Answers