Sub ClearEmpty(oDoc As Document)
Dim oTable As Table
Dim iRow As Integer, iCol As Integer
Dim bFound As Boolean
    With oDoc
        For Each oTable In oDoc.Tables
            If oTable.Columns.Count = 5 Then
                For iRow = oTable.Rows.Count To 2 Step -1
                    bFound = False
                    For iCol = 2 To oTable.Rows(iRow).Cells.Count
                        If Len(oTable.Rows(iRow).Cells(iCol).Range) > 2 Then
                            bFound = True
                            Exit For
                        End If
                    Next iCol
                    If bFound = False Then oTable.Rows(iRow).Delete
                    DoEvents
                Next iRow
            End If
        Next oTable
    End With
End Sub

Sub Macro1()
ClearEmpty ActiveDocument
End Sub

Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, Rng As Range
ActiveDocument.MailMerge.Execute
With ActiveDocument
  For Each Tbl In .Tables
    With Tbl
      For r = .Rows.Count To 2 Step -1
        Set Rng = .Rows(r).Range
        With Rng
          .Start = .Cells(2).Range.Start
          If Len(.Text) = 2 * .Cells.Count + 2 Then .Rows(1).Delete
        End With
      Next
    End With
  Next
End With
Application.ScreenUpdating = False
End Sub