Loop all sheetsand delete empty rows

[Sige]

Hi There,

Underneath macro works fine to delete the empty rows in my used-range
on the active sheet.
I want to run this procedure on all my sheets ... but the looping
fails!
While looping the sheet does not become active?

Sub DeleteEmptyRows()
Dim LastRow As Long
Dim l As Long
Dim wsh As Worksheet
On Error GoTo err
Application.ScreenUpdating = False
'For Each wsh In ActiveWorkbook.Worksheets
' With wsh
LastRow = ActiveSheet.UsedRange.Row - 1 +
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For l = LastRow To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(l)) = 0 _
Then Rows(l).Delete
Next l
' End With
'Next wsh
err:
End Sub

Hope you can help,
Sige

 

[Bob Phillips]

Sub DeleteEmptyRows()
Dim LastRow As Long
Dim l As Long
Dim wsh As Worksheet
On Error GoTo err
Application.ScreenUpdating = False
For Each wsh In ActiveWorkbook.Worksheets
With wsh
LastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
For l = LastRow To 1 Step -1
If Application.WorksheetFunction.CountA(.Rows(l)) _
= 0 Then .Rows(l).Delete
Next l
End With
Next wsh
err:
Application.ScreenUpdating = True
End Sub

 

[SIGE]

Thx Bob!

"NOSPAM" to be removed for direct mailing...