[The Off]

Пример 10 строк с желаемым результатом

[okshef]

То есть критерий отбора останется тот же, но в результаты нужно добавить 4-й столбец? Или все-таки 4-й столбец является критерием отбора?

[The Off]

4-й столбец так же является критерием поиска

[okshef]

Простите за массу уточняющих вопросов, но наличие 2-го критерия значительно усложняет задачу.
То есть алгоритм поиска выглядит так:
1) сравнить листы по второму столбцу
2) в случае отсутствия данных перейти к четвертому столбцу
3) если данные не совпадают - перенести на лист 3
4) если данные в 4-м столбце совпадают - продолжить поиск
Так?

[The Off]

1) сравнить листы по второму столбцу
2) если данные не совпадают - перенести на лист 3
3) если данные в 4-м столбце совпадают - продолжить поиск

то есть 4 столбец мы смотри уже среди найденных в 1 пункте

[okshef]

Опять неясность: то есть перенос в любом случае осуществляется при отсутствии в списке на листе 1 только по критерию 2.

если данные в 4-м столбце совпадают - продолжить поиск »

он и так продолжится... Какую роль играет критерий 4?

[The Off]

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

[okshef]

Код:

Sub findnew()
    For Each c In Worksheets(2).Columns(3).Cells
        If Worksheets(1).[c:c].Find(c.Value) Is Nothing Then
             Worksheets(2).Range("a" & c.Row).Copy Worksheets(3).Range("a" & Worksheets(3).Cells.Rows.Count).End(xlUp)(2)
             Worksheets(2).Range("c" & c.Row).Copy Worksheets(3).Range("b" & Worksheets(3).Cells.Rows.Count).End(xlUp)(2)
        End If
     If IsEmpty(c) Then Exit For
     Next
End Sub

Код поправил.

[The Off]

okshef, Все работает как нужно !!! СПАСИБО ОГРОМНОЕ !!!

Еще одно - нужно удалить дубликаты на получившемся списке (некоторые записи повторяются дважды во втором листе только обнаружил) как это добавить в модуль?

[okshef]

Добавьте после Next

Код:

Worksheets(3).UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes