Hi

Not loop through all cells of the worksheet but use the usedrange

Try this example for the workbook with the code

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim sh As Worksheet

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

For Each sh In ThisWorkbook.Worksheets

Firstrow = sh.UsedRange.Cells(1).Row
Lastrow = sh.UsedRange.Rows.Count + Firstrow - 1

With sh
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1

If Application.CountA(.Rows(Lrow)) = 0 Then
..Rows(Lrow).Delete

Next
End With

Next sh

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl



wrote in message
ups.com...
I have about 150 Worksheets in one Workbook. In all these sheets, I
need to delete the blank rows. I've already have a macro for that
purpose. Now I'm trying to figure out another macro for executing the
DeleteBlankRows macro on all the 150 worksheets. The code I have so far
only works on the active worksheet. I would really appreciate any help.
-------------------------------------------------
Sub DeleteBlankRows()

Cells.Select

Dim i As Long

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

-----------------------------------------
this is what I have so far for the other Macro:

Sub DeleteBlanksAllSheets()

Dim wk As Worksheet
For Each wk In ActiveWorkbook.Sheets

Call DeleteBlankRows

Next wk

End Sub