Выборка строк по данным и перенос на новый лист

[Poltavtcev]

Скорее всего ситуация проще пареной репы. Но в екселе второй день. Поэтому, если кто знает решение - подскажите.

Есть два листа.
На первом - прайс-лист с различными данными по столбикам: код, наименование, описание и т.д.
На втором - только коды.

Задача: с первого листа найти все строки в которых встречаются коды со второго листа и переместить их на третий лист.

Вот пример файла: Плюм


Заранее благодарен.

[Hugo121]

Элементарно - тянете ВПРом в большую таблицу коды из списка кодов - сортируете результат, копируете в новую книгу.
Если нужно делать макросом - можно банально перебирать цикл в цикле ячейки и копировать совпавшие строки в новую книгу, или словарь и 3 массива - технично и быстро.
Но если второй день - то технично рановато...

[Poltavtcev]

Первый вариант подходит.
А можно готовый вариант кода? Или Хотя-бы ткнуть где есть похожее решение
Так как мне не для того чтобы умнее в екселе стать - мне по работе нужно срочно ))

[Hugo121]

Ну вот менее техничный вариант - цикл в цикле перебор ячеек:

Sub tt()
    Dim sh, cc As Range, ccc As Range, i As Long
    Application.ScreenUpdating = False
    Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
    sh.Name = "Результат" & Sheets.Count - 2
    For Each cc In Sheets("Прайс").UsedRange.Columns(1).Cells
        For Each ccc In Sheets("Коды").[a1].CurrentRegion.Cells
            If cc.Value = ccc.Value Then
                i = i + 1
                cc.EntireRow.Copy sh.Cells(i, 1)
                Exit For
            End If
        Next ccc, cc
    Application.ScreenUpdating = True
End Sub

[Poltavtcev]

Большое спасибо!
Все работает как нужно.
Только можно без создания нового листа? А переносить на уже существующий.
Никак не могу понять что там подправить нужно.

[Hugo121]

Sub tt()
    Dim cc As Range, ccc As Range, i As Long
    Application.ScreenUpdating = False
    For Each cc In Sheets("Прайс").UsedRange.Columns(1).Cells
        For Each ccc In Sheets("Коды").[a1].CurrentRegion.Cells
            If cc.Value = ccc.Value Then
                i = i + 1
                cc.EntireRow.Copy Sheets("Результат").Cells(i, 1)
                Exit For
            End If
        Next ccc, cc
    Application.ScreenUpdating = True
End Sub

Но предполагаем, что лист Результат пустой.
Или нужно добавить его очистку в начале кода - можете записать этот процесс рекордером и добавить в код.

[Poltavtcev]

Да - вот то что именно нужно.
Премного благодарен.