Sub DeleteRows()

   Dim rng As Range, value, i As Long
   Application.ScreenUpdating = False
   Set rng = Range("F2:F60000")
   For i = rng.Rows.Count To 1 Step -1
       value = rng.Cells(i, 1).value
       If (value = 0) Then
           rng.Rows(i).EntireRow.Delete
       End If
   Next i
   Application.ScreenUpdating = True
   MsgBox "Готово", vbInformation
     
End Sub

Sub svod()
    this_wb = ThisWorkbook.Name
    path_ = "C:\Users\diyanovabd\Desktop\Новая папка (2)\"
    array_ = Array("2021_Производительность ГАП_ПФ.xlsx", "2021_Производительность ГПО_ПФ.xlsx")  
    str_ = 2
    For Each file_ In array_ 
    open_wb_path = path_ & file_ 
   
    Workbooks.Open Filename:=open_wb_path
 
        For i = 1 To Workbooks(file_).Sheets.Count
            If Workbooks(file_).Sheets(i).Range("D1").Value = "ФИО менеджера:" Then Ю      
                Workbooks(this_wb).Sheets("Выгрузка").Range("A" & str_ & ":A" & str_ + 1499).Value = _
                    file_          
                Workbooks(this_wb).Sheets("Выгрузка").Range("B" & str_ & ":AI" & str_ + 1499).Value = _
                 Workbooks(file_).Sheets(i).Range("A4:AH1503").Value  
                str_ = str_ + 1499
            End If
        Next i
       
    Workbooks(file_).Close
    Next file_
End Sub