Excel copy to Word VBA - excel

Question

I have some code that I am working on with the macro recorder. In word it always begins with Selection. This article https://exceloffthegrid.com/controlling-word-from-excel-using-vba/?unapproved=9388&moderation-hash=83a9b85f06d7f960463f59103685510b#comment-9388 says I should be able to assign the document to a variable and just insert this before .Selection. However the selection method doesn't appear in VBE for me after I type my document variable. I get a run time error 438 'object doesn't support this property or method' on my first use of the word Selection object (Selection.EndKey). As far as I can see the GoTo method should select the start of the heading.
Sub ExcelToWord()
'
' Select data in excel and copy to GIR
'
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim wb As Workbook
Dim ws As Worksheet
Dim wdApp As Word.Application
Dim GIR As Word.Document
Dim GIRName As String
Dim GEOL As String
Dim Tbl As Long
Set wdApp = New Word.Application '<<< Create a Word application object
wdApp.Visible = True '<<<< Open word so you can see any errors
GIRName = Application.GetOpenFilename(Title:="Please choose GIR to open", _
FileFilter:="Word Files *.docm* (*.docm*),")
Set GIR = wdApp.Documents.Open(GIRName) '<< call Documents.Open on the word app
'Loop through excel workbook to copy data
Set wb = ThisWorkbook
Set ws = ActiveSheet
For Each ws In wb.Worksheets
If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
ws.Activate
GEOL = Range("C9").Value
Tbl = 1
Range("A14").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Paste each worksheet's data into word as new heading
GIR.Activate
GIR.Content.GoTo What:=wdGoToHeading, Which:=wdGoToFirst, Count:=5, Name:=""
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.TypeText Text:=GEOL
Selection.TypeParagraph
Selection.Tables.Add Range:=Selection.Range, NumRows:=53, NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitWindow
With Selection.Tables(Tbl)
If .Style <> "Table1" Then
.Style = "Table1"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.PasteAndFormat (wdFormatPlainText)
Tbl = Tbl + 1
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, Count:=6, Name:=""
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.TypeParagraph
End If
Next
GIR.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

There are several issues with your code.
It is bad practice to use the Selection object for various reasons. It is better to use Range instead, both in Excel and Word.
You set the variable GIR to the document you opened but then use ActiveDocument instead.
You add your table into a paragraph formatted with Heading 2 style. For table styles to work correctly the underlying paragraph style must be Normal. This is because there is a hierarchy of styles in Word with table styles at the bottom, just above document default which is represented by Normal.
You set the variable NewTbl to point to the table you created but make no further use of it.
The line With wdApp.Selection.Tables(Tbl) will error as there will only be one table in the Selection.
I have rewritten your code as below. I have left the final 3 lines of Word code unaltered as I am unsure exactly what you are doing there, a consequence of attempting to debug code without the document being worked on. I have tested this code using some dummy data and it works for me in O365.
Sub ExcelToWord()
'
' Select data in excel and copy to GIR
'
'
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim wb As Workbook
Dim ws As Worksheet
Dim wdApp As Word.Application
Dim GIR As Word.Document
Dim GIRName As String
Dim GEOL As String
Dim Tbl As Long
Dim NewTbl As Word.Table
Dim wdRange As Word.Range
Set wdApp = New Word.Application '<<< Create a Word application object
wdApp.Visible = True '<<<< Open word so you can see any errors
GIRName = Application.GetOpenFilename(Title:="Please choose GIR to open", _
FileFilter:="Word Files *.docm* (*.docm*),")
Set GIR = wdApp.Documents.Open(GIRName) '<< call Documents.Open on the word app
'Loop through excel workbook to copy data
Set wb = ThisWorkbook
Set ws = ActiveSheet
For Each ws In wb.Worksheets
If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
ws.Activate
GEOL = Range("C9").Value
Tbl = 1
Range("A14").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Paste each worksheet's data into word as new heading
Set wdRange = wdApp.Selection.GoTo(What:=wdGoToHeading, _
Which:=wdGoToFirst, Count:=4, Name:="")
With wdRange
' wdApp.Selection.EndKey Unit:=wdLine
' wdApp.Selection.TypeParagraph
.End = .Paragraphs(1).Range.End
.InsertParagraphAfter
.MoveStart wdParagraph
.MoveEnd wdCharacter, -1
' wdApp.Selection.Style = ActiveDocument.Styles("Heading 2")
.Style = GIR.Styles(wdStyleHeading2)
' wdApp.Selection.TypeText Text:=GEOL
.Text = GEOL
' wdApp.Selection.TypeParagraph
.InsertParagraphAfter
.Collapse wdCollapseEnd
.Style = GIR.Styles(wdStyleNormal)
Set NewTbl = GIR.Tables.Add(Range:=wdRange, NumRows:=53, _
NumColumns:=7, DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitWindow)
' With wdApp.Selection.Tables(Tbl)
With NewTbl
If .Style <> "Table1" Then
.Style = "Table1"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
.Range.PasteAndFormat wdFormatPlainText
End With
' wdApp.Selection.PasteAndFormat (wdFormatPlainText)
' Tbl = Tbl + 1
wdApp.Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst, _
Count:=6, Name:=""
wdApp.Selection.MoveUp Unit:=wdLine, Count:=1
wdApp.Selection.TypeParagraph
End With
End If
Next
GIR.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub