Copy Bookmarked Text and 'Paste' into Bookmarks in New Document

Hi everyone,

I want to select bookmarked text from my source document and place it into bookmarks in my target document.

So far I have considered (code below):

1. Using a 'Go To' to find the source bookmark
2. Selecting and Copying
3. Opening Target Document
4. Using a 'Go To' tot find the target bookmark
5. Pasting

However this is not ideal as I need to do this with over 30+ bookmarks and i'm not convinced is anywhere near the most efficient/correct way to do this.

Any ideas?

Code:

---

Private Sub GT()
Dim oSource As Document
Dim r As Range
    Dim oTarget As Document
    Set oSource = ActiveDocument
    Selection.GoTo What:=wdGoToBookmark, name:="wholename"
Selection.Copy
    'Set oTarget = Documents.Add("C:\Path\Templatename.dotx")
    Set oTarget = Documents.Open("C:\Users\herriale\Desktop\New folder\Phase 2\Template (MY.G.PBR) 31.3.15.dotm")
  Selection.GoTo What:=wdGoToBookmark, name:="PlayerName"
  Selection.PasteAndFormat (wdFormatPlainText)
 End Sub

---

Say you have a source document (the activedocument) with bookmarks SourceA, SourceB, etc. and a target document C:\Target.docm with bookmarks TargetA, TargetB, etc.

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTarDoc As Document, oSourceDoc As Document
Dim oRng As Word.Range
  Set oSourceDoc = ActiveDocument
  Set oTarDoc = Documents.Open("C:\Target.docm")
  With oTarDoc
    Set oRng = .Bookmarks("TargetA").Range
    oRng.Text = oSourceDoc.Bookmarks("SourceA").Range.Text
    .Bookmarks.Add "TargetA", oRng
    Set oRng = .Bookmarks("TargetB").Range
    oRng.Text = oSourceDoc.Bookmarks("SourceB").Range.Text
    .Bookmarks.Add "TargetB", oRng
  End With
lbl_Exit:
  Exit Sub
End Sub

---

Thanks, Greg!

This worked for me, but when the text is entered into the Target document it then pushes the text after the Target bookmark onto the next line (as if enter has been pressed once the Target Bookmark has been filled) any ideas?

EDIT: FYI - the Source bookmark text is coming from a bookmark that has selected an entire word table cell.

The end of cell mark is being treated as a return character when applied to the target BM. You will need to clip the range of the source text. Assume I have a table cell bookmarked "A" and want to copy duplicate the text at bookmark "B"

Code:

---

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim oRngSource As Word.Range
  Set oRng = ActiveDocument.Bookmarks("B").Range
  Set oRngSource = ActiveDocument.Bookmarks("A").Range
  oRngSource.End = oRngSource.End - 1
  oRng.Text = oRngSource.Text
  ActiveDocument.Bookmarks.Add "B", oRng
lbl_Exit:
  Exit Sub
End Sub

---

Thanks so much, Greg.

I have managed to get your second example to work with the first so it now just takes the text without the return character.

I have one final question - In some scenarios one or more of my bookmarks from the Source Document might be deleted by the user (e.g. where that section was not relevant for their requirements) is there a way to state that if one of the bookmarks referred to in the code can't be found / doesn't exist then to move onto the next rather than crashing/stopping the macro?

Code:

---

  Sub ScratchMacro()
    'A basic Word macro coded by Greg Maxey
    Dim oTarDoc As Document, oSourceDoc As Document
    Dim oRng As Word.Range
    Dim oRngSource As Word.Range
    Set oSourceDoc = ActiveDocument
    Set oTarDoc = Documents.Open("C:\Users\herriale\Desktop\New folder\Phase 2\Template (MY.G.PBR) 31.3.15.dotm")
    With oTarDoc
    'box 1
        Set oRng = .Bookmarks("PlayerName").Range
        Set oRngSource = oSourceDoc.Bookmarks("wholename").Range
        oRngSource.End = oRngSource.End - 1
        oRng.Text = oRngSource.Text
        .Bookmarks.Add "wholename", oRng
    'box 2
        Set oRng = .Bookmarks("Club").Range
        Set oRngSource = oSourceDoc.Bookmarks("wholeclub").Range
        oRngSource.End = oRngSource.End - 1
        oRng.Text = oRngSource.Text
        .Bookmarks.Add "wholeclub", oRng
        End With
lbl_Exit:
    Exit Sub
End Sub

---

Put the following macro in the same folder as Greg's macro, then instead of using (say)

Code:

---

.Bookmarks.Add "wholename", oRng

---

call the macro e.g.

Code:

---

FillBM oTarDoc, "wholename", oRng

---

Repeat for each named bookmark. If the target bookmark doesn't exist it is simply ignored.

Code:

---

Private Sub FillBM(oDoc as Document, strBMName As String, strValue As String)
Dim oRng As Range
    With oDoc
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strBMName).Range
        oRng.Text = strValue
        oRng.Bookmarks.Add strBMName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

---

Yes, do as Graham suggests ;-)

You're too good to me!

Thanks so much for you help.

You may want to look at your revised code. You only want to clip the source range if it is a cell range. Otherwise you may be clipping the last valid character from your bookmarked text e.g.,

Code:

---

If oRngSource.Information(wdWithinTable) Then

End If

---

or something like that.

Hello Gmaxey,
This code has worked beautifully for me, thank you very muchly.
I am finding that it's pasting in plain text though, is there a an addition to the code where it can paste the source formatting?
I've tried to add on code from other forums onto yours but alas I'm a clutz at VBA. SOS :doh:

Change the code in my previous post to

Code:

---

Private Sub FillBM(oDoc As Document, strBMName As String, rngSource As Range)
Dim oRng As Range
    With oDoc
        On Error GoTo lbl_Exit
        Set oRng = .Bookmarks(strBMName).Range
        oRng.FormattedText = rngSource
        oRng.Bookmarks.Add strBMName
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

---

Thank you for the super quick response! I ended up substituting this line as I really like your original code identifying the document location and where to insert the bookmarks:

oRng.FormattedText = oSourceDoc.Bookmarks("SourceA").Range.FormattedText

Thank you for the hint!