[andreton]

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

Sub test()
On Error Resume Next: Application.ScreenUpdating = False
Dim sh2 As Worksheet: Set sh2 = Worksheets(2)
sh2.UsedRange.Clear ' очистка листа от прежних данных
Dim cell As Range, ra As Range, ForCopy As Range

' перебираем все заполненные ячейки в столбце Е
Set ra = Range([e1], Range("e" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)

For Each cell In ra.Cells
If Not Range("a:a").Find(cell) Is Nothing Then ' если аналогичный номер есть в столбце А
If ForCopy Is Nothing Then Set ForCopy = cell Else Set ForCopy = Union(ForCopy, cell)
If ForCopy.Cells.Count > 1000 Then
ForCopy.EntireRow.Copy sh2.Range("a" & sh2.Rows.Count).End(xlUp).Offset(1)
Set ForCopy = Nothing
End If
End If
Next cell
ForCopy.EntireRow.Copy sh2.Range("a" & sh2.Rows.Count).End(xlUp).Offset(1)
sh2.UsedRange.EntireColumn.AutoFit: sh2.Rows(1).Delete
sh2.Activate