Sub CleanTables()
Application.ScreenUpdating = False
Dim oTbl As Table, Rng As Range, i As Long, j As Long, StrTmp As String
With ActiveDocument
  For Each oTbl In .Tables
    On Error Resume Next
    With oTbl
      j = .Columns.Count
      For i = .Rows.Count To 1 Step -1
        With .Rows(i)
          If .Cells.Count > 1 Then
            Set Rng = .Range
            Rng.Start = .Cells(2).Range.Start
            StrTmp = Replace(Replace(Replace(Replace(Rng.Text, Chr(7), ""), vbCr, ""), " ", ""), "0", "")
            If StrTmp = "" Then .Delete
          End If
        End With
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub