Sub CleanupTables()
Application.ScreenUpdating = False
Dim Tbl As Table, Rng As Range, PrefWdthType As Long, PrefWwdthVal As Single, bFit As Boolean
For Each Tbl In ActiveDocument.Tables
  With Tbl
    Set Rng = .Range.Characters.First.Previous.Paragraphs.First.Range
    If Rng.Text Like "Table [0-9]*" Then
      Rng.ParagraphFormat.TabStops.ClearAll
      bFit = .AllowAutoFit
      .AllowAutoFit = False
      PrefWdthType = .PreferredWidthType
      PrefWwdthVal = .PreferredWidth
      With Rng
        .End = .End - 1
        .ConvertToTable Separator:=vbTab, NumRows:=1, NumColumns:=1, Format:=wdTableFormatNone, ApplyHeadingRows:=True
        With .Tables(1)
          If PrefWwdthVal <> 9999999 Then
            .PreferredWidthType = PrefWdthType
            .PreferredWidth = PrefWwdthVal
          End If
          With .Range.Cells(1).Range
            .Style = "Caption"
            .ParagraphFormat.Reset
          End With
        End With
      End With
      .Range.Characters.First.Previous.Delete
      .AllowAutoFit = bFit
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub