Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(2)) Is Nothing Then
    If Target.Cells.Count = 1 Then
        Dim s As String
        s = Target.Value
        Dim y As Long
        Dim a As Variant
        With Sheets("ДОГОВОР")
            y = .Cells(Rows.Count, 3).End(xlUp).Row
            a = .Range(.Cells(2, 2), .Cells(y, 3))
        End With
        Application.EnableEvents = False
            Range(Target, Cells(Rows.Count, Target.Column + 1)).ClearContents
            Dim i As Long
            i = 1
            For y = 1 To UBound(a, 1)
                If Left(a(y, 2), Len(s)) = s Then
                    Target.Cells(i, 1).Value = a(y, 2)
                    Target.Cells(i, 2).Value = a(y, 1)
                    i = i + 1
                End If
            Next
        Application.EnableEvents = True
    End If
    End If
End Sub