Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundArticul As Range
iLastRow = Cells(Rows.Count, "E").End(xlUp).Row
Range("G10:G" & iLastRow).ClearContents
For i = 10 To iLastRow
Set FoundArticul = Range([E3], [E1].End(xlDown)).Find(Cells(i, "E"), , xlValues, xlPart)
If Not FoundArticul Is Nothing Then
Cells(i, "G") = Cells(FoundArticul.Row, "G")
End If
Next
End Sub