Консолидация данных из разных книг макрос - VBA
Формулировка задачи:
Уважаемые!доброго времени суток! очень нужна Ваша помощь (с VBA даже не на Вы).
Есть несколько абсолютно однотипных книг только с разными названиями (количество и названия листов в книгах совпадают), необходимо консолидировать данные следующим образом, например три книги: книга1, книга2 и книга3, в каждой соответственно лист1, лист2, лист3, нужно создать копию книги, очистить диапазон ячеек для консолидации (с этим я справилась), и консолидировать по след. принципу: в копии на листе1 консолидировать диапазон ячеек (всегда постоянный, например, B10:B20) с листа1!книги1, листа1!книги2, листа1!книги3 и т.д; на листе2 - данные B10:B20 с листа2!книги1, с листа2!книги2, листа2!книги3 и т.д. и соответственно на листе3 консолидировать B10:B20 все листы3 из всех книг, на 4-ом четвертые и т.д. по индексу не получится, ибо порядок листов может отличаться
т.е. как я понимаю, берем имя листа в книге, где будет результат консолидации, ищем листы с таким же названием в книгах с данными и консолидируем (функция сумма, связь с данными - True). Количество книг и листов может быть разное. проблема организовать перебор одновременно по книгам и листам.
Заранее, огромное спасибо!!!!
Решение задачи: «Консолидация данных из разных книг макрос»
textual
Листинг программы
Sub main()
Dim WbOzenki As Workbook, WbSvod As Workbook
Dim sh As Worksheet
FileOzenki = Application.GetOpenFilename(filefilter:="Workbooks(*.xls;*.xlsx),*.xls;*.xlsx", _
Title:="Выберите файлы с КР_оценки", MultiSelect:=True)
If Not IsArray(FileOzenki) Then Exit Sub
Application.ScreenUpdating = False
For j = 1 To UBound(FileOzenki)
Workbooks.Open (FileOzenki(j))
Set WbOzenki = ActiveWorkbook
If j = 1 Then
WbOzenki.SaveAs "КР_сводная"
Set WbSvod = ActiveWorkbook
GoTo SledFile
End If
WbSvod.Activate
With WbSvod
For i = 1 To .Sheets.Count
.Sheets(i).Activate
For Each sh In WbOzenki.Sheets
If sh.Name = .Sheets(i).Name Then
sh.Range("B3:B7").Copy
.Sheets(i).Range("B3:B7").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
End If
Next
SledSheet:
Next i
End With
WbOzenki.Close False
SledFile:
Next j
WbSvod.Save
Application.ScreenUpdating = True
End Sub