Copy Excel Tables To Word

[dodonohoe]

This code comes from www.TheSpreadsheetGuru.com. It works perfectly to copy tables from an excel tab into a word document. The issue is that the tables need to be on separate tabs for the code below to work. I would like to modify the code to iterate through the worksheets in the excel workbook copying the tables as it goes and ultimately paste them into the word doc into their corresponding bookmarks. I am not familiar with Arrays which is causing me difficulties to modify the code. Cheers

Option Base 1 'Force arrays to start at 1 instead of 0


Sub ExcelTablesToWord()


'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com


Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim TableArray As Variant
Dim BookmarkArray As Variant


'List of Table Names (To Copy)
 
  TableArray = Array("Table6", "Table7")
  
  
'List of Word Document Bookmarks (To Paste To)
  BookmarkArray = Array("Bookmark1", "Bookmark2")


'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False


'Set Variable Equal To Destination Word Document
  On Error GoTo WordDocNotFound
    Set WordApp = GetObject(class:="Word.Application")
    WordApp.Visible = True
    Set myDoc = WordApp.Documents("Excel Table Word Report.docx")
    'Set myDoc = WordApp.Documents("Test.docx")
  On Error GoTo 0
    
'Loop Through and Copy/Paste Multiple Excel Tables
  For x = LBound(TableArray) To UBound(TableArray)


    'Copy Table Range from Excel
      
      Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range
      
      tbl.Copy
    
    'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
      myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False
    
    'Autofit Table so it fits inside Word Document
      Set WordTable = myDoc.Tables(x)
      WordTable.AutoFitBehavior (wdAutoFitWindow)


  Next x


'Completion Message
  MsgBox "Copy/Pasting Complete!", vbInformation
  GoTo EndRoutine
  
'ERROR HANDLER
WordDocNotFound:
  MsgBox "Microsoft Word file 'Excel Table Word Report.docx' is not currently open, aborting.", 16


'Put Stuff Back The Way It Was Found
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True


'Clear The Clipboard
  Application.CutCopyMode = False


End Sub

[snb]

This should be sufficient.

sub M_snb()
  with getobject("G:\OF\example.docx")
    for each sh in sheets
      sh.listobjects(1).range.copy
      .content.insertafter string(6,vbcr)
      .content.paragraphs.last.range.paste
    next
  end with
End Sub

[dodonohoe]

This should be sufficient.

sub M_snb()
  with getobject("G:\OF\example.docx")
    for each sh in sheets
      sh.listobjects(1).range.copy
      .content.insertafter string(6,vbcr)
      .content.paragraphs.last.range.paste
    next
  end with
End Sub

Hi SNB,

Thanks for the response. I'm not sure what to do with your code. Do I remove the array and use your getobject? Additionally, just to clarify, the code resides within the Excel file not the Word Doc (Just in case I wasn't clear on that).

Many thanks,

Des

[snb]

This code is meant for Excel.
Change the Worddocument path & filename.
Run the code in the Excel workbook that contains all those Tables.

Forget anything about bookmarks, arrays, etc.; and remove the macro you showed in post #1

I wouldn't call him a spreadsheet'guru'.

[p45cal]

to iterate through the worksheets in the excel workbook copying the tables as it goes and ultimately paste them into the word doc into their corresponding bookmarks

re: the tables; All the tables in the workbook or just the tables you list in Array("Table6", "Table7")?
If the former, do you care about bookmarks?

[dodonohoe]

Thanks SNB for your responses, much appreciated.

[dodonohoe]

re: the tables; All the tables in the workbook or just the tables you list in Array("Table6", "Table7")?
If the former, do you care about bookmarks?

Good morning P45cal,

I want to be able to select some of the tables, in this instance Table6 & Table7, I also need to be able to dictate where they are inserted into the Word document using Bookmarks. I am attaching the Macro spreadsheet for clarity.

I want to transfer two tables from an Excel Document called "Excel Tables" to a word document called "Test Word Document". I need for both of these documents to be open during the transfer.

Thanks for your help.

[p45cal]

This Excel code adapted from snb's code uses the bookmark and table names in:
TableArray = Array("Table6", "Table7")
BookmarkArray = Array("BM1", "BM2")
(of course, adjust these to suit)
to copy Excel tables to Word.
The Word bookmarks I experimented with were placeholder bookmarks.
One line that I can't get to work consistently is:
.Bookmarks(BookmarkArray(x)).Range.tables(1).autofitbehavior (2)
so it's commented-out.
It works for one table but not the other; it turns out that one bookmark was right at the end of a line (after some text) before the carriage return and the other was similarly placed but there was nothing else on that line bar a carriage return. Why should that matter?!
The block of commented-out code following that line was me trying to address the problem. It's not just an autofit problem, it's really trying to get a reliable reference to the pasted table to be able to manipulate it.
I'm not familiar with the Word object model so I might post a question on a Word vba forum.

Sub blah()
TableArray = Array("Table6", "Table7")
BookmarkArray = Array("BM1", "BM2")
'With GetObject("C:\Users\Public\Documents\vbaExpress53814\ReceivingDocument.docx")
Set wdoc = GetObject("C:\Users\Public\Documents\vbaExpress53814\ReceivingDocument.docx")
With wdoc
  .Parent.Visible = True
  For x = LBound(TableArray) To UBound(TableArray)
    For Each sh In Sheets
      For Each lob In sh.ListObjects
        If TableArray(x) = lob.Name Then
          'Copy Table Range from Excel
          lob.Range.Copy
          'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
          .Bookmarks(BookmarkArray(x)).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
          '.Bookmarks(BookmarkArray(x)).Range.tables(1).autofitbehavior (2)

          'This block of comments is my trying to get the line above (autofitbehavior) to work with both pasted tables:
          'Set BMRange = .Bookmarks(BookmarkArray(x)).Range
          'BMRange.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
          '.Bookmarks.Add BookmarkArray(x), BMRange
          '.Bookmarks(BookmarkArray(x)).Range.Select  'autofitbehavior (2)

        End If
      Next lob
    Next sh
  Next x
End With  'wdoc
End Sub

The above addresses your original question rather than working through a list of documents and tables in a worksheet. I'll try and look at that later.

[dodonohoe]

This Excel code adapted from snb's code uses the bookmark and table names in:
TableArray = Array("Table6", "Table7")
BookmarkArray = Array("BM1", "BM2")
(of course, adjust these to suit)
to copy Excel tables to Word.
The Word bookmarks I experimented with were placeholder bookmarks.
One line that I can't get to work consistently is:
.Bookmarks(BookmarkArray(x)).Range.tables(1).autofitbehavior (2)
so it's commented-out.
It works for one table but not the other; it turns out that one bookmark was right at the end of a line (after some text) before the carriage return and the other was similarly placed but there was nothing else on that line bar a carriage return. Why should that matter?!
The block of commented-out code following that line was me trying to address the problem. It's not just an autofit problem, it's really trying to get a reliable reference to the pasted table to be able to manipulate it.
I'm not familiar with the Word object model so I might post a question on a Word vba forum.

Sub blah()
TableArray = Array("Table6", "Table7")
BookmarkArray = Array("BM1", "BM2")
'With GetObject("C:\Users\Public\Documents\vbaExpress53814\ReceivingDocument.docx")
Set wdoc = GetObject("C:\Users\Public\Documents\vbaExpress53814\ReceivingDocument.docx")
With wdoc
  .Parent.Visible = True
  For x = LBound(TableArray) To UBound(TableArray)
    For Each sh In Sheets
      For Each lob In sh.ListObjects
        If TableArray(x) = lob.Name Then
          'Copy Table Range from Excel
          lob.Range.Copy
          'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5)
          .Bookmarks(BookmarkArray(x)).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
          '.Bookmarks(BookmarkArray(x)).Range.tables(1).autofitbehavior (2)

          'This block of comments is my trying to get the line above (autofitbehavior) to work with both pasted tables:
          'Set BMRange = .Bookmarks(BookmarkArray(x)).Range
          'BMRange.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
          '.Bookmarks.Add BookmarkArray(x), BMRange
          '.Bookmarks(BookmarkArray(x)).Range.Select  'autofitbehavior (2)

        End If
      Next lob
    Next sh
  Next x
End With  'wdoc
End Sub

The above addresses your original question rather than working through a list of documents and tables in a worksheet. I'll try and look at that later.

Hi P45cal,

Thanks very much for the response.

Much appreciated.

[Melissa123]

very helpful information shared here... It's helped

[p45cal]

…trying to get a reliable reference to the pasted table to be able to manipulate it.
I'm not familiar with the Word object model so I might post a question on a Word vba forum.

…which I duly did at http://www.msofficeforums.com/word-v...cel-table.html and got a working solution from macropod aka Paul Edstein. So here it is working:

Sub blah()
TableArray = Array("Table6", "Table7")
BookmarkArray = Array("BM2", "BM1")
With GetObject("C:\Users\Public\Documents\vbaExpress53814\ReceivingDocument.docx")
  .Parent.Visible = True
  For x = LBound(TableArray) To UBound(TableArray)
    For Each sh In Sheets
      For Each lob In sh.ListObjects
        If TableArray(x) = lob.Name Then
          'Copy Table Range from Excel
          lob.Range.Copy
          'Paste Table into MS Word & format
          With .Bookmarks(BookmarkArray(x)).Range
            .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
            .MoveEnd wdTable, 1
            .Tables(1).AutoFitBehavior (wdAutoFitWindow)
          End With
        End If
      Next lob
    Next sh
  Next x
End With
End Sub

Thank you Paul.