Макрос аля ВПР для формирования свода из закрытых книг

[MaxxVer]

Добрый день! Вынужден еще раз потревожить. Столкнулся с тем что макрос производит расчет очень долго при большом количестве показателей. Скажите, может быть, есть макрос который сделает то же самое, но не через ВПР, а методом простого копирования диапазона? Т.е. так же по имени файла, листа и показателя вставить данные, но из указанного диапазона (например со столбца D по I).

[Hugo121]

Если можно сгруппировать эти файлы/листы, чтобы обрабатывать сразу весь лист одним куском одним заходом - тогда можно сделать быстро на массивах/словаре.
"Показатели" могут быть и вразброс, как в примере.
Ну а если так, как сейчас - то с большим расходом памяти может быть тоже можно сделать: при первом обращении к файлу все данные запоминать в массив и всё помнить до конца работы. Т.е. все книги и все листы... а не поочерёдно.
"может быть, есть макрос" - может быть где-то и есть, такую вероятность исключать нельзя Но "методом простого копирования диапазона" быстрее не будет - его ведь сперва нужно найти

[MaxxVer]

Уважаемый Hugo, если Вас не затруднит, помогите пожалуйста с макросом. Я пробовал дописать, но полностью готового решения не нашел, а у самого не получается (знания VBA практически нет)...
Принцип действия макроса: в Лист2 свода копируются данные с Книг (папка Данные) друг под друга, только те листы, которые указаны в таблице свода. В стобец A свода проставляется имя соответсвующего файла (во все ячейки), в столбец B - имя листа, соответственно данные вставляются начиная со столбца C.

[MaxxVer]

Нашел макрос который делает почти то что надо. Но требуется доработка:
- макрос вставляет название книги в столбец А, надо чтобы еще название листа вставлял в столбец B.
- макрос собирает данные с указанной ячейки до конца данных. Надо чтобы начальная ячейка была прописана (C11), конец диапазона определялся поиском слова "" в столбце B.

Option Explicit

Sub Consolidated_Range_of_Books_and_She ets()
Dim iPivotRange As Range, iDestinationRange As Range, iBeginRange As Range, Sheet
Dim iRngAddress As String, oAwb As String, DataSheet As String, _
iCopyAddress As String, sSheetName As String, oFile
Dim lLastrow As Long, lLastRowMyBook As Long
Dim iLastColumn As Integer
Dim Str() As String

ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
DataSheet = ThisWorkbook.ActiveSheet.Name
On Error Resume Next
Set iBeginRange = Application.InputBox("Âûáåðèòå äèàïàçîí ñáîðà äàííûõ." & vbCrLf & _
"1. Ïðè âûáîðå òîëüêî îäíîé ÿ÷åéêè äàííûå áóäóò ñîáðàíû ñî âñåõ ëèñòîâ íà÷èíàÿ ñ ýòîé ÿ÷åéêè. " & _
vbCrLf & "2. Ïðè âûäåëåíèè íåñêîëüêèõ ÿ÷ååê äàííûå áóäóò ñîáðàíû òîëüêî ñ óêàçàííîãî äèàïàçîíà âñåõ ëèñòîâ.", Type:=8)
If iBeginRange Is Nothing Then Exit Sub
sSheetName = InputBox("Ââåäèòå èìÿ ëèñòà, ñ êîòîðîãî ñîáèðàòü äàííûå(åñëè íå óêàçàí, òî äàííûå ñîáèðàþòñÿ ñî âñåõ ëèñòîâ)", "Ïàðàìåòð")
If sSheetName = "" Then sSheetName = "*"
On Error GoTo 0
With Application.FileDialog(msoFileDialo gFilePicker)
.AllowMultiSelect = True
.InitialFileName = "*.*"
.Title = "Âûáåðèòå ôàéëû"
If .Show = False Then Exit Sub
For Each oFile In .SelectedItems
Workbooks.OpenText Filename:=oFile
oAwb = Dir(oFile, vbDirectory)

Application.ScreenUpdating = False
Workbooks(oAwb).Activate
For Each Sheet In Sheets
If Sheet.Name Like sSheetName Then
Sheet.Activate
Select Case iBeginRange.Count
Case 1
lLastrow = Cells(1, 1).SpecialCells(xlLastCell).Row
iLastColumn = Cells.SpecialCells(xlLastCell).Colu mn
iCopyAddress = Range(Cells(iBeginRange.Row, iBeginRange.Column), Cells(lLastrow, iLastColumn)).Address
Case Else
iCopyAddress = iBeginRange.Address
lLastrow = iBeginRange.Rows.Count
iLastColumn = iBeginRange.Columns.Count
End Select
lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cell s.SpecialCells(xlLastCell).Row + 1
iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(Da taSheet).Range(iRngAddress)
End If
Next Sheet
Workbooks(oAwb).Close False
Next oFile
End With
Application.ScreenUpdating = True
End Sub

[Hugo121]

Я пока пас, занят.
Так что никому не возбраняется поучаствовать
Одно скажу - открывать на каждую строку книгу бестолково, нужно кодом определить, какие книги нужны, какие листы в них нужны, затем сразу группами брать данные, чтоб лишний раз книги не трогать.
Код будет непростой.
Но пока его писать не на чем - где пример с указанием листов (так ведь изменилось задание)?

[MaxxVer]

Сообщение от Hugo121

Я пока пас, занят.
Так что никому не возбраняется поучаствовать
Одно скажу - открывать на каждую строку книгу бестолково, нужно кодом определить, какие книги нужны, какие листы в них нужны, затем сразу группами брать данные, чтоб лишний раз книги не трогать.
Код будет непростой.
Но пока его писать не на чем - где пример с указанием листов (так ведь изменилось задание)?

Жаль. Тогда обращаюсь к другим экспертам.
Пример во вложениии: Данные с Книг 1-3.
На счет указания листов согласен, давайте пропишем в макросе, для данного примера Лист1, Лист4.
Файлы прописывать не надо, меня усвтраивает так как сделано (выбор файлов из конкретного места).
Заране премного благодарен.