' 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