Sub DeleteBlankRows()
Const cstrTitle As String = "DeleteBlankRows"
Dim strErrMsg As String
Dim lngRowTop As Long
Dim lngRowBtm As Long
Dim lngColLft As Long
Dim lngColRyt As Long
Dim lngRowCntr As Long
Dim rngRow As Range
Dim rngCell As Range
Dim bolEmpty As Boolean
Dim wksToUse As Worksheet
Dim rngToUse As Range
On Error GoTo Err_Exit
For Each wksToUse In ThisWorkbook.Worksheets
Set rngToUse = wksToUse.UsedRange
lngRowTop = rngToUse.Cells(1).Row
lngRowBtm = rngToUse.Cells(rngToUse.Cells.Count).Row
lngColLft = rngToUse.Cells(1).Column
lngColRyt = rngToUse.Cells(rngToUse.Cells.Count).Column
lngRowCntr = lngRowTop
While (lngRowCntr <= lngRowBtm)
Set rngRow = wksToUse.Range(wksToUse.Cells(lngRowCntr, lngColLft), wksToUse.Cells(lngRowCntr, lngColRyt))
bolEmpty = True
For Each rngCell In rngRow
If (Not Trim(Format(rngCell.Value)) = vbNullString) Then
bolEmpty = False
Exit For
End If
Next
If bolEmpty Then
If (lngRowTop <> lngRowBtm) Then
rngRow.Delete xlShiftUp
lngRowCntr = lngRowCntr - 1
lngRowBtm = lngRowBtm - 1
End If
End If
lngRowCntr = lngRowCntr + 1
Wend
Next wksToUse
Housekeeping:
Set rngToUse = Nothing
Set rngRow = Nothing
Set wksToUse = Nothing
Exit Sub
Err_Exit:
strErrMsg = Err.Number & ": " & Err.Description
Err.Clear
MsgBox strErrMsg, vbCritical + vbOKOnly, cstrTitle
Resume Housekeeping
End Sub