Sub qqq()
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Пример").Activate
    Dim lr1 As Long
    Dim lr2 As Long
    Dim s
For lr1 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    lr2 = Cells(Rows.Count, 17).End(xlUp).Row
On Error Resume Next
    s = Range("J:J").Find(What:=Cells(lr1, 2).Value, lookAt:=xlWhole).Row
   If Err > 0 Then
    Range("Q" & lr2 + 1 & ":V" & lr2 + 1).Value = _
    Range("A" & lr1 & ":F" & lr1).Value
   End If
    Err = 0
Next lr1
    Application.ScreenUpdating = True
End Sub