Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Target.Column = 3 Then
            Application.EnableEvents = False
            Target.Cells(1, 2).ClearContents
            If Target.Value = "" Then
            Else
                Dim r As Range
                Set r = Worksheets("Лист2").Range("C3:D19")
                Dim y As Long
                On Error Resume Next
                y = WorksheetFunction.Match(Target.Value, r.Columns(1), 0)
                On Error GoTo 0
                If y > 0 Then
                    Sheets("Пример").Activate
                    Target.Cells(1, 2).Value = r.Cells(y, 2)
                End If
            End If
            Application.EnableEvents = True
        End If
    End If
End Sub

With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
End With