поиск значений в книге и копирование соот данных

[xitriy]

Помогите пожалуйста с задачкой:
Имеется 2 экселевских файла("книга1" и "книга2").
1) "книга1". нужно перебрать все значения в столбце А (А1,А2,.....А14000,.. до конца)
2)Для каждого из этих значений ищем совпадения в "книга2", столбик В (в книге несколько листов)
3)при нахождении совпадения, копируем значение столбца Е соответствующей строки("книга2"), в "книга1" в столбец W строки искомого значения.

Буду очень признателен за помощь.

[Viper]

А где вопрос?

[Template]

(в книге несколько листов)

Это означает, что нужно искать во всех раб.листах этой книги ?

[xitriy]

Это означает, что нужно искать во всех раб.листах этой книги ?

Да, искать по всем листам.

[xitriy]

А где вопрос?

Нужен код, у самого пока неполучается сделать, тока учусь. Заранее благодарен.

[alibek]

Нужен код, у самого пока неполучается сделать, тока учусь. Заранее благодарен.

Не можешь сам, попроси Excel.
Просить надо заклинанием "Запись макроса".

[Template]

Обе книги обязательно должны быть открыты, ну и не возбраняется, предварительно указать необходимое расширение, а также индекс или имя раб.листа, используемые в действительности.

Код: Выделить всё

Public Sub Test()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim wsList As Worksheet, strText As String
    Dim rngSource As Range, rngCell As Range, rngResult As Range
   
    Application.ScreenUpdating = False
   
    Set wb1 = Workbooks("Книга1.xls")
    Set wb2 = Workbooks("Книга2.xls")
   
    With wb1.Worksheets(1) 'wb1.Worksheets("Лист1")
         Set rngSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
   
    For Each rngCell In rngSource
        strText = CStr(rngCell.Value)
        For Each wsList In wb2.Worksheets
            Set rngResult = wsList.Columns(2).Find(strText, , xlValues, xlWhole)
            If Not rngResult Is Nothing Then
               rngCell(1, 23).Value = rngResult(1, 4).Value
               Exit For
            End If
        Next
    Next
   
    Application.ScreenUpdating = True
End Sub