Макрос: открыть книгу, перейти на лист, найти строку и скопировать

[MaxxVer]

Добрый день, уважаемые знатоки!

К сожалению созданные мною ранее темы остались без решения, поэтому решился создать новую, более упрощенную задачу.
Подскажите, пожалуйста код, или натолкните на подобный макрос.
Суть макроса: в ячейках D3:I6 файла ИТОГ собираются данные из книг 1-3. Т.е.
1) макрос открывает книгу в соответсвии с именем в столбце А,
2) переходит на лист этой книги в соответствии с именем в столбце В,
3) находит строку по условию в соответсвии со столбцом C
и копирует диапазон D:I этой строчки в файл ИТОГ.
Скажите возможно ли это реализовать или не стоит и пытаться найти ответ?
Заранее буду очень признателен!

[MaxxVer]

Пример прилагаю.

[Hugo121]

Реализовать возможно, и даже довольно просто.
Это я пишу не потому, что берусь делать, а чтоб Вы не отчаивались
Конкретно мне делать не хочется...


P.S.
Вообще-то чуть подумав, вижу, что чтоб сделать хорошо и быстро - нужно чуть подумать...
Это так, каламбур - если серьёзно, то чтоб сделать хорошо и быстро (а ведь проблема именно в скорости - "медленное" решение на ВПР() уже есть) - нужно хорошо подумать

[MaxxVer]

Спасибо, за ответ. Буду ждать того кто возьмется...

[Hugo121]

Вообще-то задача выглядит интересной. Я даже затрудняюсь... пока не вижу в деталях алгоритма...

[staniiislav]

пробуйте... главное чтобы все файлы находились в одной папке!

Добавлено позже:

хотя можно еще добавить пару строк:

Sub ПоискИкопированиеДанныхПоКнигамИлистам()
Dim wsh As Worksheet, x As Range, s As Range, p, sh, sh_ As String, z As String
Application.ScreenUpdating = False
If MsgBox("Найти и сохранить данные?", vbYesNo, "Подтверждение") = vbNo Then Application.ScreenUpdating = True: Exit Sub
Set wsh = ThisWorkbook.ActiveSheet
Set x = Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Range("D3:I" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
With CreateObject("Scripting.Dictionary")
    For Each sh In x
            sh_ = wsh.Cells(sh.Row, 2)
            z = wsh.Cells(sh.Row, 3)
                On Error Resume Next
                Workbooks.Open (ThisWorkbook.Path & "\" & sh & ".xls")
                Workbooks(sh & ".xls").Activate
                    If Err = 0 Then
                        Sheets(sh_).Activate
                            If Err = 0 Then
                        With Workbooks(sh & ".xls").Sheets(sh_)
                            Set s = .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
                            Set p = s.Find(what:=z, LookAt:=xlWhole)
                                If Not p Is Nothing Then
                                    .Range(.Cells(p.Row, 2), .Cells(p.Row, 7)).Copy
                                    wsh.Range("D" & wsh.Cells(sh.Row, 4).Row).PasteSpecial Paste:=xlPasteValues
                                Else
                                    wsh.Range("D" & wsh.Cells(sh.Row, 4).Row) = "На [" & sh_ & "] " & " значения [" & z & "], не найдено"
                                End If
                        End With
                    Else
                        Err.Clear
                        wsh.Range("D" & wsh.Cells(sh.Row, 4).Row) = "В книге [" & sh & ".xls] " & " лита [" & sh_ & "], не найдено"
                    End If
                    Else
                        Err.Clear
                        wsh.Range("D" & wsh.Cells(sh.Row, 4).Row) = "[" & sh & ".xls] книги, не найдено"
                    End If
                With Workbooks(sh & ".xls"): .Close True: End With
    Next sh
End With
[A3].Select
MsgBox "Обработка данных завершена", vbInformation, "Оповещение:"
Application.ScreenUpdating = True
End Sub

[DiemonStar]

staniiislav,
в вашем макросе есть один заметный минус: если в таблице будет по 1000 значений для каждой из трёх книг в папке, то 3000 операций открытия и закрытия будут явным перебором. Корректнее будет открыть все книги, а потом уже в цикле заполнять ячейки значениями, после чего закрыть книги... при больших объёмах прибавка будет заметной...

[staniiislav]

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

staniiislav,
в вашем макросе есть один заметный минус: если в таблице будет по 1000 значений для каждой из трёх книг в папке, то 3000 операций открытия и закрытия будут явным перебором. Корректнее будет открыть все книги, а потом уже в цикле заполнять ячейки значениями, после чего закрыть книги... при больших объёмах прибавка будет заметной...

согласен с Вами абсолютно! можно будет переделать

[MaxxVer]

Спасибо большое. Буду тестировать...

[Hugo121]

Я вот тоже эту проблему начал решать здесь ещё в другой теме ( http://www.programmersforum.ru/showthread.php?t=210047 - там правда пример чуть посложнее, к этому код не подойдёт без переделки) - сделал макросом на ВПР() (по полным столбцам) - говорят что долго.
Казанский на sql.ru сделал в принципе аналогично на ИНДЕКС(ПОИСКПОЗ)) (но уже на ограниченном диапазоне) - вроде заметно быстрее, но думаю всё равно не устраивает.
На Планете я озвучил такой возможный алгоритм - нужен словарь/коллекция/массив из имён файлов, где каждому имени принадлежит словарь/коллекция/массив нужных его листов, где каждому листу принадлежит словарь/коллекция/массив позиций и критериев.
Далее перебором по цепочке делаем дело.
Вот ктоб реализовал - а мы бы посмотрели
P.S. вариант с открытием/закрытием файлов на каждую строку тоже уже был на Планете, правда не такой красивый, но тоже через find

P.P.S. Станислав, а зачем там словарь?