Sub FormatTables()
' Turn Off Screen Updating
Application.ScreenUpdating = False
Dim SBar As Boolean, Rng As Range, i As Long, j As Long, TblCell As Cell
' Store current Status Bar status, then switch on
SBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
With ActiveDocument
  j = .Tables.Count
  ' Process all tables
  For i = .Tables.Count To 1 Step -1
    StatusBar = "Processing table: " & j - i + 1 & " of " & j
    With .Tables(i)
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = "([! ])[ ]@([! ])"
        .Replacement.Text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@([! ])"
        .Replacement.Text = "\1"
        .Execute Replace:=wdReplaceAll
      End With
      Set Rng = .Range
      .ConvertToText Separator:=vbTab
    End With
    Rng.ConvertToTable Separator:=vbTab
    With .Tables(i)
      ' Set Autofit
      .AllowAutoFit = False
      ' Turn off text wrapping in cells
      For Each TblCell In .Range.Cells
        TblCell.WordWrap = False
      Next
      ' Reduce the cell left/right padding
      .LeftPadding = 2.5
      .RightPadding = 2.5
      With .Range
        ' Set the font point size
        .Font.Size = 13
        ' Set the space before/after
        With .ParagraphFormat
          .SpaceBefore = 0
          .SpaceAfter = 0
          .Alignment = wdAlignParagraphCenter
        End With
      End With
      ' Clear preferred dimensions
      .PreferredWidthType = wdPreferredWidthAuto
      .Columns.PreferredWidthType = wdPreferredWidthAuto
      ' Set Autofit
      .AllowAutoFit = True
    End With
    DoEvents
  Next
End With
' Clear the Status Bar
Application.StatusBar = ""
' Restore original Status Bar status
Application.DisplayStatusBar = SBar
' Turn On Screen Updating
Application.ScreenUpdating = True
End Sub