Cropping or Deleting useless data

Here's a VBA way of doing it.
The code as it is now only works with sheet 1. It deletes all the rows that are zero from column A to the last used column. I presumed all the data you want to keep is always at the top of a data block, and when the zero rows start, they are all zero rows until the last row of the block.
Cheers

Dropbox link coz the site is still broken
https://www.dropbox.com/s/mx089pja2v...Rows.xlsb?dl=0

Option Explicit

Sub DeleteZeroLines()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With

Dim Ws1 As Worksheet
Dim rCell As Range
Dim Top0Row As Long, Bot0Row As Long, OldBot0Row As Long, cColNum As Long
Dim AWF As Object
Set Ws1 = ThisWorkbook.Sheets(1)
Set AWF = Application.WorksheetFunction

On Error Resume Next
'   Find last used column
    cColNum = Ws1.Cells.Find(what:="*", LookIn:=xlValues, _
        lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlPrevious, _
        MatchCase:=False, searchformat:=False).Column
        
'   Find top row of data
    Top0Row = Ws1.Columns(1).Find(what:="*", LookIn:=xlValues, _
        lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, searchformat:=False).Row
        
'   Find bottom row of first block of data
    Bot0Row = Ws1.Columns(1).Find(what:="", After:=Ws1.Cells(Top0Row, 1), LookIn:=xlValues, _
        lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False, searchformat:=False).Row - 1
        OldBot0Row = Bot0Row

Do ' Start loop

    For Each rCell In Ws1.Range(Ws1.Cells(Top0Row, 1), Ws1.Cells(Bot0Row, 1))
        If AWF.Sum(Ws1.Range(Ws1.Cells(rCell.Row, 1), Ws1.Cells(rCell.Row, cColNum))) = 0 Then
        Top0Row = rCell.Row
        Exit For
        End If
    Next rCell
    
    Ws1.Range(Ws1.Cells(rCell.Row, 1), Ws1.Cells(Bot0Row, 1)).EntireRow.Delete
    
'   Force routine it to continue if a group of data doesn't contain 3 cells in a row containing 0
    If rCell.Row = 0 Then Top0Row = Bot0Row
    
'   Find top row of next block of data
        Top0Row = Ws1.Columns(1).Find(what:="*", After:=Ws1.Cells(Top0Row, 1), LookIn:=xlValues, _
            lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
            MatchCase:=False, searchformat:=False).Row

'   Find bottom used row of next block of data
        Bot0Row = Ws1.Columns(1).Find(what:="", After:=Ws1.Cells(Top0Row, 1), LookIn:=xlValues, _
            lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
            MatchCase:=False, searchformat:=False).Row - 1
            
        If Bot0Row > OldBot0Row Then
            OldBot0Row = Bot0Row
        Else: End If
    
'   Test if find has returned to the top of the worksheet meaning
'   it's finished the last block of data
    If Bot0Row < OldBot0Row Then GoTo ExitOut

Loop

ExitOut:
On Error GoTo 0
With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
End With
Exit Sub

End Sub