Letzte nicht leer Zellen löschen

Sub test()
Dim wks As Worksheet
Dim i As Integer
Dim lz As Integer
Dim z As Long
Set wks = Worksheets("Tabelle1")
Application.ScreenUpdating = False
i = ActiveWorkbook.Worksheets().Count
On Error Resume Next
'wks.Activate
For i = 2 To Worksheets.Count - 1
If Worksheets(i).Visible = xlSheetVisible Then
lz = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(i)
If .Cells(lz, 1)  "" Then .Rows(lz).Delete
End With
End If
Next i
Application.ScreenUpdating = True
End 

Sub
Danke schon mal im Voraus. Grüße