transfer cell(s)/tables from excel to word bookmarks

[RM567]

Hi,
I am new to VBA and am struggling with how to transfer information from my excel spread sheet to predetermined bookmarks, within a word document. I have managed to workout how to transfer individual cells, however I am stuck with transferring tables? my code is below, any help appreciated.

Sub test()
Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("info")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\Users\robert.mack\Documents\Custom Office Templates\Quotation.dotx"
With objWord.ActiveDocument
.bookmarks("Company1").Range.Text = ws.Range("D2").Value
.bookmarks("Address1").Range.Text = ws.Range("D3").Value
.bookmarks("Address2").Range.Text = ws.Range("D4").Value
.bookmarks("Address3").Range.Text = ws.Range("D5").Value
.bookmarks("Address4").Range.Text = ws.Range("D6").Value
.bookmarks("Postcode1").Range.Text = ws.Range("D7").Value
.bookmarks("Firstname1").Range.Text = ws.Range("D9").Value
.bookmarks("Surname1").Range.Text = ws.Range("D10").Value
.bookmarks("Date1").Range.Text = ws.Range("D12").Value
.bookmarks("Scheme1").Range.Text = ws.Range("D14").Value
.bookmarks("Issue1").Range.Text = ws.Range("D15").Value
.bookmarks("Project1").Range.Text = ws.Range("D16").Value
.bookmarks("Surname2").Range.Text = ws.Range("D10").Value
.bookmarks("email1").Range.Text = ws.Range("D18").Value
.bookmarks("email2").Range.Text = ws.Range("D19").Value
.bookmarks("Pdf1").Range.Text = ws.Range("D20").Value
.bookmarks("Pdf2").Range.Text = ws.Range("D21").Value
.bookmarks("Pdf3").Range.Text = ws.Range("D22").Value
.bookmarks("Bdm1").Range.Text = ws.Range("B43").Value
.bookmarks("Bdmmobile1").Range.Text = ws.Range("C43").Value
.bookmarks("Bdmemail1").Range.Text = ws.Range("E43").Value
.bookmarks("Author1").Range.Text = ws.Range("B52").Value
.bookmarks("Authormobile1").Range.Text = ws.Range("C52").Value

End With

Set objWord = Nothing
End Sub

Many Thanks
RM567

 

[Norie]

Word actually has something called PasteExcelTable which as the name suggested pastes an Excel table into a Word document.

Here's a simple example.

Sub CopyTableToWord()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdRng As Object
Dim tbl As ListObject

    Set tbl = Sheet1.ListObjects(1)
    
    Set wrdApp = CreateObject("Word.Application")
    
    wrdApp.Visible = True
    
    Set wrdDoc = wrdApp.documents.Open("C:\Test\CopyExcelTableToWordEx.docx")
    
    Set wrdRng = wrdDoc.bookmarks("InsertTableHere").Range
    
    tbl.Range.Copy
    
    
    wrdRng.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    
End Sub

 

[RM567]

Word actually has something called PasteExcelTable which as the name suggested pastes an Excel table into a Word document.

Here's a simple example.

Sub CopyTableToWord()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdRng As Object
Dim tbl As ListObject

    Set tbl = Sheet1.ListObjects(1)
    
    Set wrdApp = CreateObject("Word.Application")
    
    wrdApp.Visible = True
    
    Set wrdDoc = wrdApp.documents.Open("C:\Test\CopyExcelTableToWordEx.docx")
    
    Set wrdRng = wrdDoc.bookmarks("InsertTableHere").Range
    
    tbl.Range.Copy
    
    
    wrdRng.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    
End Sub

Hi Thanks for the info, I have tried the above but keep getting an runtime error '9' subscript out of range wit the below code.

Set tbl = Sheet1.ListObjects(1)

I have edited the data specific to my requirements? as I said I am really new to VBA?

Thanks

RM567

 

[Norie]

Do you actually have a table on your sheet in Excel?

If you don't you could try replacing ListObjects(1) here with the range you want to copy.

 Set tbl = Sheet1.ListObjects(1)

If you do that remove Range from here.

tbl.Range.Copy