VBA Subscript out of range and Error 9

Question

I know this error has been defined in earlier posts for e.g. here. I am pretty new to VBA and do not really understand the explanation there.

I am using the following code to automate adding multiple tables to a word document by bookmarking them as explained in the link http://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with-vba.I am getting a Subscript out of range (error 9)

The tables are created in the same sheet manually by myself by selecting a particular range in the excel sheet.

Here below you can find the code. I would really be grateful if someone can identify where I am going wrong.

Thank you very much in advance.

---

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("Siko_LEFIS_v0.1.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

      tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range  '####Here is where i get the subbscipt out of range error#######
      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 'Siko_LEFIS_v0.1.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 1

The code below (some slight tweaks for my environment) worked for me. Most likely cause of your error was that you don't have a table with the expected name on one of your sheets.

You were also missing Set on that line (required when assigning a value to an object variable)

Option Explicit

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

Sub ExcelTablesToWord()

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
Dim x As Long, sht As Worksheet


  TableArray = Array("Table1", "Table2")
  BookmarkArray = Array("Bookmark1", "Bookmark2")

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  On Error GoTo WordDocNotFound
    Set WordApp = GetObject(class:="Word.Application")
    WordApp.Visible = True
    Set myDoc = WordApp.Activedocument
    'Set myDoc = WordApp.Documents("Siko_LEFIS_v0.1.docx")
  On Error GoTo 0


  For x = LBound(TableArray) To UBound(TableArray)

      Set sht = ThisWorkbook.Worksheets(x)
      Set tbl = sht.ListObjects(TableArray(x)).Range

      myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False

      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 'Siko_LEFIS_v0.1.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

I would also recommend that you try to avoid using the Option Base 1 setting: it might appear to make dealing with arrays easier, but changing the default array behavior causes more problem than it solves.