Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d_ As Range
    c_ = 1
    r0_ = 2
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    Set d_ = Intersect(Target(1), Cells(r0_, c_).Resize(n_))
    If Not d_ Is Nothing Then
        Cells(r0_, c_).Resize(n_).Validation.Delete
        On Error Resume Next
        With d_.Validation
            .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
            .InputTitle = "Описание"
            With Sheets("Лист2")
                c1_ = 1
                r01_ = 2
                n1_ = .Cells(.Rows.Count, c1_).End(3).Row - r01_ + 1
                im_ = WorksheetFunction.VLookup(d_, .Cells(r01_, c1_).Resize(n1_, 2), 2, 0)
            End With
            .InputMessage = im_
        End With
    End If
End Sub

im_ = WorksheetFunction.VLookup(d_, .Cells(r01_, c1_).Resize(n1_, 4), 4, 0)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    With Target.Validation
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .InputTitle = "Описание"
        .InputMessage = WorksheetFunction.VLookup(Target, Worksheets(2).Columns("A:B"), 2, False)
    End With
End Sub