Create Snapshot in Word with Excel Tables

[lrhollid]

I am trying to create a macro that will generate a snapshot in Word. The snapshot includes information such as number and type of attendees at professional development sessions, and 2 tables. I have set up my bookmarks in Word, and the below code worked perfectly until I tried to add a second table.

When I run the code, the data for the bookmarks and the first table appear in my Word document. However, the second table is not pasted, and the file is not saved. I am not receiving an error message.

I am using Excel 2013 and Windows 8.1.

Thank you for your help.


Sub createSnapshot()


On Error GoTo errorHandler
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim mywdRange As Word.Range
Dim SchoolName As Excel.Range
Dim Principals As Excel.Range
Dim IFs As Excel.Range
Dim Other As Excel.Range
Dim Total As Excel.Range
Dim Month As Excel.Range
Dim WordTable As Word.Table
Dim WordTable2 As Word.Table
Dim tbl As Excel.Range
Dim tbl2 As Excel.Range
Dim FName As String


Set wdApp = New Word.Application
With wdApp
.Visible = True
.WindowState = wdWindowStateMaximize
End With

Dim WordTemplate As String


WordTemplate = Worksheets("Set Up").Range("L5")


Set myDoc = wdApp.Documents.Add(Template:=WordTemplate)

'Set bookmarks to their excel range
Set SchoolName = Sheets("Data Conversion").Range("A2")
Set Principals = Sheets("Data Conversion").Range("b2")
Set Teachers = Sheets("Data Conversion").Range("C2")
Set IFs = Sheets("Data Conversion").Range("D2")
Set Other = Sheets("Data Conversion").Range("E2")
Set Total = Sheets("Data Conversion").Range("F2")
Set Month = Sheets("Data Conversion").Range("G2")



With myDoc.Bookmarks
.Item("SchoolName").Range.InsertAfter SchoolName
.Item("Principals").Range.InsertAfter Principals
.Item("Teachers").Range.InsertAfter Teachers
.Item("IFs").Range.InsertAfter IFs
.Item("Other").Range.InsertAfter Other
.Item("Total").Range.InsertAfter Total
.Item("Month").Range.InsertAfter Month


End With


'Select the first table
Set tbl = Sheets("Attendance").ListObjects("Table3").Range


'Copy Excel Table Range
tbl.Copy



'Paste Table into Word
myDoc.Paragraphs(13).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)


'Select the second table
Set tbl2 = Sheets("PDANCW").ListObjects("PDANCW2").Range
'
'Copy Excel Table Range
tbl2.Copy
'
'Paste Table into Word
WordDoc.Range(WordDoc.Content.End - 1).Paste
WordDoc.Range.InsertParagraphAfter
myDoc.Paragraphs(30).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

'Autofit Table so it fits inside Word Document
Set WordTable2 = myDoc.Tables(2)
WordTable2.AutoFitBehavior (wdAutoFitWindow)



FName = Worksheets("Data Conversion").Range("A2")
'save the word document with all information pasted in
'use the value stored in FName as the name of the new file
wdApp.ActiveDocument.SaveAs (Application.ActiveWorkbook.Path + "\" + FolderName + "\" + FName + ".docx")
wdApp.ActiveDocument.Close

Application.CutCopyMode = False

errorHandler:
Set wdApp = Nothing
Set myDoc = Nothing
Set mywdRange = Nothing

End Sub