Консолидация данных из разных книг макрос - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д