Sub FixTables()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
With ActiveDocument
  For Each Tbl In .Tables
    With Tbl
      With .Rows
        .LeftIndent = 0
        .WrapAroundText = False
        .Alignment = wdAlignRowCenter
      End With
      .TopPadding = 0
      .LeftPadding = 0
      .RightPadding = 0
      .BottomPadding = 0
      .AllowAutoFit = False
      .PreferredWidthType = wdPreferredWidthAuto
      .Columns.DistributeWidth
      .Columns(1).Width = CentimetersToPoints(1#)
      .Columns(2).Width = CentimetersToPoints(3.75)
      .Columns(3).Width = CentimetersToPoints(3.75)
      .Columns(4).Width = CentimetersToPoints(3.75)
      .Columns(5).Width = CentimetersToPoints(3.75)
  End With
  While .Tables.Count > 1
    .Tables(1).Range.Characters.Last.Next.Delete
  Wend
Next
End With
Application.ScreenUpdating = True
End Sub