Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False                'Не обрабатывать события.
Dim r As Range
On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    ad_ = Target.Address(0, 0)
    With Sheets("База клиентов")
        r0_ = 3
        c0_ = 1
        r1_ = .Cells(.Rows.Count, c0_).End(3).Row
        c1_ = 16
        nr_ = r1_ - r0_ + 1
        nc_ = c1_ - c0_ + 1
        ar = .Cells(r0_, c0_).Resize(nr_, nc_)
    End With
    Select Case ad_
        Case "B4"
            c_ = 4
'        Case "B6"
'            c_ = 6
        Set r = Sheets("База клиентов").Columns(4).Find(Target.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
        If r Is Nothing Then
            Range("E20").Value = "phone not found"
        Else
            Range("E20").Value = r(1, 15).Value
        End If

    Case "B7"
            c_ = 7
            cс_ = 6
        Case "E7"
            c_ = 15
        Case Else
            Exit Sub
    End Select
    ReDim ar1(1 To 8, 1 To 1)
    ReDim ar2(1 To 8, 1 To 1)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        If cс_ Then
            z_ = Target.Offset(-1).Value & Target.Value
            For i = 1 To nr_
                .Item(ar(i, cс_) & ar(i, c_)) = i
            Next i
        Else
            z_ = Target.Value
            For i = 1 To nr_
                .Item(ar(i, c_)) = i
            Next i
        End If
        If .Exists(z_) Then
            str_ = .Item(z_)
            For j = 1 To 8
                ar1(j, 1) = ar(str_, j)
                ar2(j, 1) = ar(str_, j + 8)
            Next j
            Application.EnableEvents = 0
            Range("B1").Resize(8) = ar1
            Range("E1").Resize(7) = ar2
            Application.EnableEvents = 1
        End If
    End With
Application.EnableEvents = True
End Sub