Copy data from one word document to another that has predefined bookmarks

[AA_20069]

Hi All,

I am looking for some assistance in a matter, not sure if best to do it in Excel or Word VBA; so i'll start with Word VBA.

I basically have one Word document that is generated from a Application (via a template built into the system). What I am looking to do is take this Word document - which is laided out as follows:

1 Heading
1.1 Sub heading
Table 1 (Contains 12 Rows, 4 Columns - first row is a header)
Table 2 (Contains 2 Rows, 1 Column - first row is a header)
Table 3 (Contains 2 Rows, 1 Column - first row is a header)

and copy the data in each of the Tables into another templated word document that has predefined bookmarks - thought this may help? But its not a simple copy and paste as the layout is different in the 2nd word document.

Any help or advice would be appreciated.

Regards/

[gmayor]

If you don't want the tables simply copying to the new document, then the following will help you write values from the tables to the bookmarks in the other document:

Define oTarget as your document to receive the data. This can be a new document or an existing document e.g. as shown
'Set oTarget = Documents.Add("C:\Path\Templatename.dotx")
Set oTarget = Documents.Open("C:\Path\Docname.docx")

You can then run through the tables extracting each cell value to the new location
FillBM oTarget, "bookmarkname", oCell.Text
(only one table and cell shown)




Option Explicit

Sub CopyData()
Dim oSource As Document
Dim oTarget As Document
Dim oTable As Table
Dim oCell As Range
Set oSource = ActiveDocument
'Set oTarget = Documents.Add("C:\Path\Templatename.dotx")
Set oTarget = Documents.Open("C:\Path\Docname.docx")

'Process the table(s)
Set oTable = oSource.Tables(1)
'Process the cells
Set oCell = oTable.Cell(2, 1).Range 'Row 2, Column 1)
oCell.End = oCell.End - 1 'eliminate the end of cell marker
FillBM oTarget, "bookmarkname", oCell.Text
'Repeat as required with the appropriate addresses and values
lbl_Exit:
Exit Sub
End Sub

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:
Exit Sub
End Sub