Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub

Dim x, y, i&, j&
With Sheets("Рецептура")
    x = .Range("B3").CurrentRegion.Value
    y = .Range("P2").CurrentRegion.Value
End With

Application.EnableEvents = False
For i = 1 To UBound(x)
    If x(i, 1) = Target.Value Then
        For j = 2 To UBound(x, 2)
            If x(i, j) <> "" Then
                Target.Offset(j - 1) = x(i, j)
                Target.Offset(j - 1, 1) = y(i, j - 1)
            End If
        Next j
    End If
Next i
Application.EnableEvents = True
End Sub