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