Dim myTable As Table
Dim myRow As Row
Dim myCell As Cell
Dim myRange As Range
Dim IsEmpty As Boolean

For Each myTable In ActiveDocument.Tables
For Each myRow In myTable.Rows
IsEmpty = True
For Each myCell In myRow.Cells
Set myRange = myCell.Range
myRange.MoveEnd Unit:=wdCharacter, Count:=-1
If myRange.Text <> "" Then IsEmpty = False
Next myCell
If IsEmpty Then myRow.Delete
Next myRow
Next myTable

Sub DelBlankRows()
Application.ScreenUpdating = False
Dim i As Long, j As Long
With ActiveDocument
  For i = .Tables.Count To 1 Step -1
    With .Tables(i)
      For j = .Rows.Count To 1 Step -1
        On Error Resume Next 'skip vertically merged cells
        With .Rows(j)
          If Trim(Replace(Replace(.Range.Text, Chr(13) & Chr(7), ""), Chr(160), "")) = "" Then .Delete
        End With
        On Error GoTo 0
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub