speedup the code for deleting rows

Hi,
I have this code which is supposed to delete rows containing "0" and "null" in all worksheets.
But this is taking too much time and seems like system is gonna hang.

Is there anything we can do to speed up code. Also, its "search all worksheet" function is not working, and is doing work in just the active worksheet.
Please help.

Sub WorksheetLoop()

    Dim I As Long
    Dim sh As Worksheet
    Dim LastRow As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

       'Begin the loop.
        For Each sh In ActiveWorkbook.Worksheets
        
          LastRow = sh.Cells(Rows.Count, "D").End(xlUp).Row
        
           For I = LastRow To 1 Step -1
             If (Cells(I, "D").Value) = "0" Then
                 Cells(I, "D").EntireRow.Delete
             End If
          Next I
            
       

           For I = LastRow To 1 Step -1
             If (Cells(I, "D").Value) = "" Then
                 Cells(I, "D").EntireRow.Delete
             End If
          Next I
            
        Next sh

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With

End Sub