=СУММ(ЕСЛИОШИБКА(ЕСЛИ(Т(ДВССЫЛ("'"&{"январь";"февраль";"март";"апрель";"май";"июнь";"июль";"август";"сентябрь";"октябрь";"ноябрь";"декабрь"}&"'!G2"))="да";Ч(ДВССЫЛ("'"&{"январь";"февраль";"март";"апрель";"май";"июнь";"июль";"август";"сентябрь";"октябрь";"ноябрь";"декабрь"}&"'!E2"))*Ч(ДВССЫЛ("'"&{"январь";"февраль";"март";"апрель";"май";"июнь";"июль";"август";"сентябрь";"октябрь";"ноябрь";"декабрь"}&"'!F2")));))

Sub CollectAllSheets()
Application.Goto Reference:="Stays"
Dim i As Integer
Dim sh As Worksheet, stsh As Worksheet
Dim stays As Range, r As Range
Set stays = Range("Stays")
If stays.Rows.Count > 1 Then
stays.Resize(stays.Rows.Count - 1).Delete
End If

For i = 2 To Application.ActiveWorkbook.Sheets.Count
Set sh = Application.ActiveWorkbook.Sheets(i)
If i > 2 Then
Range("Stays").Rows(i - 1).ListObject.ListRows.Add AlwaysInsert:=True
End If
Set r = Range("Stays").Rows(i - 1)
r.Cells(1, 1) = sh.Cells(17, 2).Value
r.Cells(1, 2) = sh.Cells(17, 4).Value
r.Cells(1, 3) = sh.Cells(18, 5).Value
r.Cells(1, 4) = sh.Cells(16, 7).Value
r.Cells(1, 7) = sh.Cells(39, 8).Value
Next
End Sub

Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Desktop\Test\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub