Sub UpdateTables2()
    Dim rng         As Range
    Dim aTbl As Table
    Dim aRow As Row
    Dim x           As Long
    Dim MyTables    As Long: MyTables = ActiveDocument.Tables.Count
    Dim MyNote      As String: MyNote = "Does this table have a table name"
    Dim answer      As String
    Dim aRng As Range
    
    Application.ScreenUpdating = False
    For Each aTbl In ActiveDocument.Tables
      Set aRng = aTbl.Range
      aRng.MoveStart Unit:=wdParagraph, Count:=-1
      aRng.Select
      ActiveWindow.ScrollIntoView aRng, True
      
      Set aRow = aTbl.Rows.Add(BeforeRow:=aTbl.Rows(1))
      aRow.Range.Cells.Merge
      Set aRng = aRng.Paragraphs(1).Range
      aRng.MoveEnd Unit:=wdCharacter, Count:=-1
      aRow.Range.Cells(1).Range.FormattedText = aRng.FormattedText
      aRng.Paragraphs(1).Range.Delete
      aRow.Borders(wdBorderTop).LineStyle = wdLineStyleNone
      aRow.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
      aRow.Borders(wdBorderRight).LineStyle = wdLineStyleNone
      aRow.Range.Style = "Caption"
    Next aTbl
    Application.ScreenUpdating = True
End Sub