Pasted

' sauce: http://stackoverflow.com/a/9379968/6338845
Option Explicit
 
Sub DeleteEmptyRows()
    Dim i As Long
    Dim DelRange As Range
 
    On Error GoTo Whoa
 
    Application.ScreenUpdating = False
 
    For i = 1 To 500
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Rows(i)
            Else
                Set DelRange = Union(DelRange, Rows(i))
            End If
        End If
    Next i
 
    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True
 
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
 
' sauce: https://support.microsoft.com/en-us/kb/142126
      Sub CleanAllEmptyRows()
 
         ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet
 
         ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets
 
            ' Insert your code here.
            ' This line displays the worksheet name in a message box.
            Call DeleteEmptyRows
         Next
 
      End Sub