Sub BlanckRowsHide()
  Dim a, d, r&
  a = Intersect(ActiveSheet.UsedRange, [a:c])
  ReDim d(1 To UBound(a), 1 To 1)
  For r = 1 To UBound(a)
    If Not IsEmpty(a(r, 1)) Then
      d(r, 1) = 1
    ElseIf Not IsEmpty(a(r, 2)) Then
      d(r, 1) = 1
    ElseIf Not IsEmpty(a(r, 3)) Then
      d(r, 1) = 1
    End If
  Next
  [d1].Resize(UBound(d), 1) = d
  If ActiveSheet.AutoFilter Is Nothing Then [a:d].AutoFilter
  If ActiveSheet.AutoFilter.Range.Columns.Count < 4 Then
    [a1].AutoFilter: [a:d].AutoFilter
  End If
  ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:="<>"
End Sub