Sub u_429()
Application.ScreenUpdating = False
x = Sheets(2).Cells(Rows.Count, "a").End(xlUp).Row
If x > 1 Then Sheets(2).Range("a2:l" & x).Clear
a = Cells(Rows.Count, "i").End(xlUp).Row
For Each b In Range("i5:i" & a)
c = b.Row
d = Application.Match(b, Range("i4:i" & c - 1), 0)
e = Application.Match(b, Range("i" & c + 1 & ":i" & a + 1), 0)
f = IsNumeric(d)
g = IsNumeric(e)
If f Or g Then
h = Sheets(2).Cells(Rows.Count, "a").End(xlUp).Row + 1
Range("a" & c & ":l" & c).Copy Sheets(2).Range("a" & h)
End If
Next
'если нужна сортировка---------------------------------------------------
If h > 2 Then
Sheets(2).Range("a2:l" & h).Sort key1:=Sheets(2).Range("i2:i" & h), _
order1:=xlAscending, Header:=xlNo
End If
'------------------------------------------------------------------------
Application.ScreenUpdating = True
End Sub