Sub CleanUp()
Dim Tbl As Table, TblCl As Cell, Rng As Range, RngDel As Range
With ActiveDocument
  For Each Tbl In .Tables
    For Each TblCl In Tbl.Range.Cells
      Set Rng = TblCl.Range
      Rng.End = Rng.End - 1
      Set RngDel = Rng.Characters.Last
      RngDel.Collapse wdCollapseEnd
        Do While Asc(RngDel.Characters.First.Previous) < 33
          If RngDel.Start = Rng.Start Then Exit Do
          RngDel.Start = RngDel.Start - 1
        Loop
      RngDel.Text = vbNullString
      If Rng.Paragraphs.Count > 1 Then
      If Len(Rng.Paragraphs.First.Range) = 1 Then Rng.Paragraphs.First.Range = vbNullString
      End If
    Next
  Next
End With
End Sub