您的代码有几个问题.

1. 出于各种原因，使用Selection对象是一种不好的做法.***在Excel和Word中都使用Range.
2. 您将变量GIR设置为打开的文档，但改为使用ActiveDocument.
3. 您将表格添加到以 Heading 2 样式设置的段落中.为了使表格样式正常工作，基础段落样式必须为 Normal .这是因为在

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.

我已按如下方式重写了您的代码.我不确定Word的最后3行保持不变，因为我不确定您在做什么，这是尝试在不处理文档的情况下调试代码的结果.我已经使用一些虚拟数据测试了此代码，它在O365中对我有用.

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