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

[ajhez]

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?



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

[gmaxey]

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.

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

[ajhez]

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.

[gmaxey]

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"


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

[ajhez]

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?



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

[gmayor]

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

.Bookmarks.Add "wholename", oRng
call the macro e.g.

FillBM oTarDoc, "wholename", oRng
Repeat for each named bookmark. If the target bookmark doesn't exist it is simply ignored.



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

[gmaxey]

Yes, do as Graham suggests ;-)

[ajhez]

You're too good to me!

Thanks so much for you help.

[gmaxey]

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.,


If oRngSource.Information(wdWithinTable) Then

End If

or something like that.

[MissO101]

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:

[gmayor]

Change the code in my previous post to

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

[MissO101]

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!