Sub Загрузка()
   
   Dim fso As Object
      Dim lastrow As Integer
      Set fso = CreateObject("Scripting.FileSystemObject")
     search fso.GetFolder(ThisWorkbook.Path)
End Sub

Sub search(fold As Object)
Dim lastrow, lastsotr As Integer
Dim i, j As Integer
Dim fil As Object
Dim wb As Workbook
Dim ws As Worksheet
i = 1 
lastrow = ThisWorkbook.Sheets("Сводная таблица").UsedRange.Row + ThisWorkbook.Sheets("Сводная таблица").UsedRange.Rows.Count - 1
For Each fil In fold.Files 
If (InStr(1, fil.Name, ".xlsx", vbTextCompare) > 0) And (InStr(1, fil.Name, "годовой", vbTextCompare) = 0) Then Set wb = Workbooks.Open(fil.Path) 
Set sh = wb.Sheets("Лист1")
sh.Select
lastsotr = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1 
For j = 3 To lastsotr 
If sh.Cells(j, 1) > 0 Then
Cells(lastrow + i, 2) = fil.Name
Cells(lastrow + i, 3) = sh.Cells(j, 1)
End If
Next j
End If
'wb.Close
Next fil
End Sub