Paste table from multiple excel sheets into word file and name word as sheet name VBA

Question

I have excel file with many sheets. In each sheet I have 3 tables which I need to paste into a word document. I need to create a word template and name it as sheet and paste 2 tables.

Sub Separate()

 'Remember: this code requires a referece to the Word object model

 'dimension some local variables
Dim rng As Range 'our source range
Dim wdApp As New Word.Application 'a new instance of Word
Dim wdDoc As Word.Document 'our new Word document
Dim t As Word.Range 'the new table in Word as a range
Dim myWordFile As String 'path to Word template


 'initialize the Word template path
 'here, it's set to be in the same directory as our source workbook
myWordFile = ThisWorkbook.Path & "\DocWithTableStyle.dot"

 'get the range of the contiguous data from Cell A1
Set rng = Range("A1").CurrentRegion
 'you can do some pre-formatting with the range here
rng.HorizontalAlignment = xlCenter 'center align the data
rng.Copy 'copy the range

 'open a new word document from the template
Set wdDoc = wdApp.Documents.Add(myWordFile)

Set t = wdDoc.Content 'set the range in Word
t.Paste 'paste in the table
With t 'working with the table range
    .Style = "GreenBar" 'set the style created for the table
     'we can use the range object to do some more formatting
     'here, I'm matching the table with using the Excel range's properties
    .Tables(1).Columns.SetWidth (rng.Width / rng.Columns.Count), wdAdjustSameWidth
End With

 'until now the Word app has been a background process
wdApp.Visible = True
 'we could use the Word app object to finish off
 'you may also want to things like generate a filename and save the file
wdApp.Activate

End Sub

This is what I was trying but getting error

---------------------------
Microsoft Visual Basic for Applications
---------------------------
Compile error:

User-defined type not defined
---------------------------
OK   Help   
---------------------------

reference to word and excel are selected

Answer 1

Something like this should get the job done.

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("Table1", "Table2", "Table3", "Table4", "Table5")

'List of Word Document Bookmarks (To Paste To)
  BookmarkArray = Array("Bookmark1", "Bookmark2", "Bookmark3", "Bookmark4", "Bookmark5")

'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")
  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

Answer 2

I have updated the code, check and let me know if it is working?

Before running the macro go to Microsoft Visual basic for Applications window

then in tools-> references

and check the "Microsoft Word xx object library"

and ok

then delete the table you have pasted in your template and save it, as the macro will paste that, you don't want two of them.

Updated macro

Sub runMacro()

    save_path = ThisWorkbook.Path & "\"

    Call makeDocument("Name 1", save_path)
    Call makeDocument("Name 2", save_path)
    Call makeDocument("Name 3", save_path)

End Sub

Sub makeDocument(sheet_name, save_path)

     'Remember: this code requires a referece to the Word object model

     'dimension some local variables
    Dim rng As Range 'our source range
    Dim wdApp As New Word.Application 'a new instance of Word
    Dim wdDoc As Word.Document 'our new Word document
    Dim t As Word.Range 'the new table in Word as a range
    Dim myWordFile As String 'path to Word template


     'initialize the Word template path
     'here, it's set to be in the same directory as our source workbook
    myWordFile = ThisWorkbook.Path & "/Word Template.docx"

     'get the range of the contiguous data from Cell A1
    'Set rng = Range("A1").CurrentRegion
    Set rng = Sheets(sheet_name).Range("A1:E23")
     'you can do some pre-formatting with the range here
    'rng.HorizontalAlignment = xlCenter 'center align the data
    rng.Copy 'copy the range

     'open a new word document from the template
    Set wdDoc = wdApp.Documents.Add(myWordFile)

    'wdDoc.Paragraphs(2).Range.PasteExcelTable False, False, flase

    Set t = wdDoc.Content 'set the range in Word
    Set t = wdDoc.Paragraphs(2).Range

    t.Paste 'paste in the table
    With t 'working with the table range
        '.Style = "Strong" 'set the style created for the table
        '.Style = "Grid Table 4 - Accent 2"
         'we can use the range object to do some more formatting
         'here, I'm matching the table with using the Excel range's properties
        .Tables(1).Columns.SetWidth (rng.Width / rng.Columns.Count), wdAdjustSameWidth
    End With

     'until now the Word app has been a background process
    wdApp.Visible = True
     'we could use the Word app object to finish off
     'you may also want to things like generate a filename and save the file
    wdApp.Activate

    file_name = save_path & sheet_name 'set the directory where files would be saved

    'save file
    wdDoc.SaveAs2 Filename:=file_name, FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15


End Sub