=FILTER(D1:D; ((A1:A="Имя")*(F1:F="Фамилия")))

Private Sub CommandButton1_Click()
    If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing Then Exit Sub
    
    ActiveCell.EntireRow.Copy Sheets("Буфер").Rows(1)
    cPathD = ActiveWorkbook.Path & "\"
    cFileD = cPathD & "Z.docx"
    cCellName = ActiveCell.Address(False, False, xlA1)
    
    Set WD = CreateObject("Word.Application")
    WD.Visible = False
    WD.Documents.Open Filename:=cFileD
    'WD.Application.ScreenUpdating = False
    For Each aF In WD.ActiveDocument.Fields
        aF.Unlink
    Next
    'WD.Application.ScreenUpdating = True
    WD.Application.DisplayAlerts = False
    WD.ActiveDocument.SaveAs Filename:=cPathD & "Çàÿâêà" & cCellName & ".pdf", FileFormat:=wdFormatPDF
    WD.Application.DisplayAlerts = True
    WD.Application.Quit
    Set WD = Nothing

End Sub

Sub Макрос1()
'
' Макрос1 Макрос
' Сортировка
'

'
    ActiveWorkbook.Worksheets("Справочники").ListObjects("Таблица2").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Справочники").ListObjects("Таблица2").Sort. _
        SortFields.Add Key:=Range("Таблица2[[#All],[Контрагенты]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Справочники").ListObjects("Таблица2").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long

    If Target.Cells.Count > 1 Then Exit Sub
       If Not Intersect(Target, Range("F2:F1000")) Is Nothing Then
            If IsEmpty(Target) Then Exit Sub
                If WorksheetFunction.CountIf(Worksheets("Справочники").Range("Контрагенты"), Target) = 0 Then
                    lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
                        If lReply = vbYes Then
                            Worksheets("Справочники").Range("Контрагенты").Cells(Worksheets("Справочники").Range("Контрагенты").Rows.Count + 1, 1) = Target
                            Application.Run "Макрос1"
                        End If
                End If
        End If
End Sub