Excel copy to Word VBA

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-usin

Answer 1

There are several issues with your code.

1. It is bad practice to use the Selection object for various reasons. It is better to use Range instead, both in Excel and Word.
2. You set the variable GIR to the document you opened but then use ActiveDocument instead.
3. 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.
4. You set the variable NewTbl to point to the table you created but make no further use of it.
5. 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