Sub XLTablesWord()


Dim i           As Long

Dim TableArray() As Variant
TableArray = Range("TableNames")

Dim BookmarkArray() As Variant
BookmarkArray = Range("BookmarkNames")


    
    '---------PASTE TO DOCUMENT
    With GetObject("C:\Users\Dan\Desktop\Tables.docx")
    
    
        .Parent.Visible = True
        
        For i = LBound(TableArray) To UBound(TableArray)
            For Each sh In Sheets
                
            For Each lob In sh.ListObjects
                
                
            If TableArray(i, 1) = lob.Name Then
                
            lob.Range.Copy       'Copy Table Range from Excel
                
                
            With .Bookmarks(BookmarkArray(i, 1)).Range    'Paste Table into MS Word & format
            
                .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
                
                .MoveEnd wdTable, 1
                .Tables(1).AutoFitBehavior (wdAutoFitWindow)
                
                End With
                End If
                Next lob
            Next sh
        Next i
    End With
   
End Sub