Макрос сортировки по совпадениям

[sofa1199]

Здравствуйте!
Изучила много подобных тем на вашем сайте, в каждом есть что-то нужное для моего случая, но собрать воедино у меня самостоятельно опыта не хватило. Нужна помощь.
Необходимо сравнить каждое значение столбца 3 "Листа1" со значениями столбца 4 "Листа2". При совпадении: копировать строки только "листа2" полностью на лист "Совпадение", при этом заголовок из "листа2". При несовпадении: копировать всю строку с "листа1" на лист "Несовпадение".
Количество строк исходных двух листов может содержать до 20 тыс.

[IgorGO]

поместите этот

Sub Compare()
  Dim r As Long, r2 As Long, frg As Range
  r = 2
  Do While Not IsEmpty(Cells(r, 3))
    Set frg = FindAll(Cells(r, 3))
    If frg Is Nothing Then
      With Worksheets("НеСовпадение")
        Cells(r, 3).EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
      End With
    Else
      With Worksheets("Совпадение")
        frg.EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
      End With
    End If
    r = r + 1
  Loop
End Sub


Function FindAll(what As Range) As Range
  Dim urg As Range, rg As Range, adr As String
  With Worksheets("Лист2")
    Set rg = .Columns(4).Find(what, .Cells(1, 4), xlValues, xlWhole)
    If rg Is Nothing Then Exit Function Else Set urg = rg:  adr = rg.Address
    Do While Not rg Is Nothing
      Set urg = Union(rg, urg)
      Set rg = .Columns(4).Find(what, rg, xlValues, xlWhole): If rg.Address = adr Then Exit Do
    Loop
    Set FindAll = urg
  End With
End Function

в программный модуль
выполните Sub Compare() при активном лист1

Удачи!