Макрос на сбор данных с разных книг и вывод срзнач

Добрый день! Столкнулся с задачей, но что то не знаю как её решить и нужно ли вообще под такое писать макрос.
Есть файлы в которых на разных листах есть однотипная информация, мне нужно сделать свод в новый файл по названию тех листов! Старые файлы при этом будут обновляться, помогите, пожалуйста, пример направляю.

Вложения

Книга1.xlsx (14.6 Кб, 9 просмотров)

0

Направил подробный пример как должно быть, загвоздка в том, что нужно сделать именно отдельный файл, который будет собирать эти данные из разных книг в одну таблицу по датам, я пока что профан в VBA, так бы сделал проверки таблиц на условия, фио всегда будет соответствовать названию листа, но не знаю как написать в макросе такую проверку.

Вложения

Примерработы.xlsx (11.8 Кб, 16 просмотров)

0

Попробовал сделать, но почему-то два последних вечно не попадают, поправка, файл один, просто с разных листов надо собирать значения и в ячейки итога записать среднее.

Sub main()
Dim x, y, sum, i, dataprosl, x1 As Long
Dim lCol As Long


Application.Workbooks("Примерработы").Sh eets(4).Select
For x1 = 0 To Application.Workbooks("Примерработы").Sh eets(4).Cells(Rows.Count, 1).End(xlUp).Row
dataprosl = Application.Workbooks("Примерработы").Sh eets(4).Range("A" & x1 + 2)
x = 1
For x = 1 To 2
If Application.Workbooks("Примерработы").Sh eets(4).Range("B" & x1 + 2).Value = Application.Workbooks("Примерработы").Sh eets(x).Name Then Application.Workbooks("Примерработы").Sh eets(x).Select Else

Next x


lCol = 1
For lCol = 1 To Application.Workbooks("Примерработы").Sh eets(x).Cells(1, Columns.Count).End(xlToLeft).Column
i = Cells(1, Columns.Count).End(xlToLeft).Column


If dataprosl = Cells(1, lCol) Then Application.Workbooks("Примерработы").Sh eets(4).Range("C" & x1 + 2).Value = Application.Workbooks("Примерработы").Sh eets(4).Range("C" & x1 + 2).Value + Cells(2, lCol)

Next lCol
Next x1




End Sub

Добавлено через 3 часа 38 минут
Уже всё сделал! Благодарю, если кто то хотел помочь)

0

Sub main()
Dim x, y, sum, i, dataprosl, x1, itog As Long
Dim lCol As Long
Dim lLastCol As Integer
Range("C2:l999").Clear
Sheets(4).Select
For x1 = 2 To Sheets(4).Cells(Rows.Count, 1).End(xlUp).Row
dataprosl = Sheets(4).Range("A" & x1)

For x = 0 To 3
If Sheets(4).Range("B" & x1).Value = Sheets(x + 1).Name Then Sheets(x + 1).Select
Next x

lLastCol = Cells.SpecialCells(xlLastCell).Column
i = Application.WorksheetFunction.CountIf(Ra nge("B1:AX1"), dataprosl)
For lCol = 1 To lLastCol



If dataprosl = Cells(1, lCol) Then Sheets(4).Range("C" & x1).Value = Sheets(4).Range("C" & x1).Value + Cells(2, lCol)
Next lCol
Sheets(4).Range("C" & x1).Value = Sheets(4).Range("C" & x1).Value / i

Next x1
Sheets(4).Select
Columns("C:L").Select
Selection.NumberFormat = "0.00"
End Sub

0