Graham,
True but just a bit bored and looking for something to do ;-).
Perhaps:
Sub DeleteEmptyRows()
Dim Tbl As Table, cel As Cell
Dim i As Long, j As Long, n As Long, fEmpty As Boolean
Application.ScreenUpdating = False
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
For i = n To 1 Step -1
fEmpty = True
For j = 2 To Tbl.Rows(i).Cells.Count
Set cel = Tbl.Rows(i).Cells(j)
If Not fcnJustWhiteSpace(cel) Then
fEmpty = False
Exit For
End If
Next j
If fEmpty = True Then Tbl.Rows(i).Delete
Next i
Next Tbl
End With
Set cel = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub
Private Function fcnJustWhiteSpace(cel) As Boolean
Dim oChr
fcnJustWhiteSpace = True
For Each oChr In cel.Range.Characters
Select Case Asc(oChr)
Case 9, 11, 13, 32, 160
Case Else: fcnJustWhiteSpace = False: Exit For
End Select
Next
End Function