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