Liste sans les " lignes zéros"

Sub EnleveLigne()
Dim DerLig As Long, i As Integer
Application.ScreenUpdating = False
DerLig = Range("BG65530").End(xlUp).Row
For i = DerLig To 2 Step -1
    If Cells(i, 59).Value = 0 And Cells(i, 60) = 0 And Cells(i, 61) = 0 Then Rows(i).EntireRow.Delete
Next i
Application.ScreenUpdating = True
End Sub

Sub regroup()
Dim Plg(), TabloReport(), i&, j&, k&
With Sheets("Feuil1")
    Plg = .Range(.Cells(3, 59), .Cells(Rows.Count, 61).End(xlUp)).Value
End With
For i = LBound(Plg, 1) To UBound(Plg, 1)
    For j = 1 To 3
        If Plg(i, j) = 0 Then Var = Var + 1
    Next j
    If Var <> 3 Then
        TabRow = TabRow + 1
        ReDim Preserve TabloReport(1 To 3, 1 To TabRow)
        For k = 1 To 3
            TabloReport(k, TabRow) = Plg(i, k)
        Next k
    End If
    Var = 0
Next i
With Sheets("Feuil2")
    .UsedRange.ClearContents
    .Cells(1, 1).Resize(TabRow, 3) = Application.Transpose(TabloReport)
End With
End Sub

Sub regroup()
Dim Plg(), TabloReport(), i&, j&, k&
With Sheets("Feuil1")
    Plg = .Range(.Cells(3, 59), .Cells(Rows.Count, 61).End(xlUp)).Value
    For i = LBound(Plg, 1) To UBound(Plg, 1)
        For j = 1 To 3
            If Plg(i, j) = 0 Then Var = Var + 1
        Next j
        If Var <> 3 Then
            TabRow = TabRow + 1
            ReDim Preserve TabloReport(1 To 3, 1 To TabRow)
            For k = 1 To 3
                TabloReport(k, TabRow) = Plg(i, k)
            Next k
        End If
        Var = 0
    Next i
    .Range(.Cells(3, 62), .Cells(3, 64).End(xlDown)).ClearContents
    .Cells(3, 62).Resize(TabRow, 3) = Application.Transpose(TabloReport)
End With
End Sub