' Collapse the used range all spreadsheets in a worksbook by eliminating blanks rows.
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
'
' Get the boundaries of the range to use.
lngRowTop = rngToUse.Cells(1).Row
lngRowBtm = rngToUse.Cells(rngToUse.Cells.Count).Row
lngColLft = rngToUse.Cells(1).Column
lngColRyt = rngToUse.Cells(rngToUse.Cells.Count).Column
'
' Check the rows.
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