Sub Hidden()
    Application.ScreenUpdating = False
    i = 10 'номер строки, с которой начнется обработка
    k=i
    While Not IsEmpty(Cells(i, 2)) ' проверяем каждую строчку пока не встретимся с пустым значением
        If Cells(i, 2).Value = 0 Then   ' прячем  строки с нулевым значением
            Rows(i).Hidden = True
        End If
        i = i + 1
    Wend
    Range("A" & k-1 & ":B" & i - 1).SpecialCells(xlCellTypeVisible).Copy
    Sheets("результат").Select
    Range("D2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Sub CopyRows()
Dim ArrData()
Dim i As Long, k As Long
    With Лист3 ' родитель - лист "отчет"
        ' данные в массив: от A10 до последней  заполненной в В
        ArrData = .Range("A10:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
        
        For i = 1 To UBound(ArrData) ' цикл по строкам
            If ArrData(i, 2) Then ' если сумма есть
                k = k + 1 ' счетчик строк выгрузки
                ArrData(k, 1) = ArrData(i, 1) ' заполняем массив выгрузки
                ArrData(k, 2) = ArrData(i, 2)
            End If
        Next i
    End With
    
    ' если строки с суммами есть, выгружаем массив на лист
    Application.ScreenUpdating = False
    If k > 0 Then Лист1.Cells(3, 4).Resize(k, 2).Value = ArrData
    Application.ScreenUpdating = True
End Sub