Sub Sortir()
    Dim d As Range, d0 As Range 'd и d0 - ячейки
    On Error Resume Next 'пропуск ошибок
    Set d0 = Selection(1) 'd0 - первая ячейка выделенного диапазона на листе
    сb_ = Replace(Cells(1, d0.Column).Address(0, 0), 1, "") 'буква столбца d0
    t_ = "Столбец ''" & сb_ & "'' сортируем по возрастанию?" 'формируем текст для сообщения
    t_ = t_ & vbLf & vbLf & "''Да'' - по возрастанию"
    t_ = t_ & vbLf & "''Нет'' - по убыванию"
    t_ = t_ & vbLf & "''Отмена'' - не сортировать"
    s_ = MsgBox(t_, vbYesNoCancel, "Сортировка по столбцу " & сb_) 'выводим сообщение
    If s_ < 6 Then Exit Sub 'если нажато что-то, ктоме Да и Нет - выход из макроса
    Application.ScreenUpdating = 0 'откл. обновление экрана
    or_ = s_ - 5 'по возрастанию или по убыванию. MSGBOX см https://msdn.microsoft.com/ru-ru....%3Dtrue
    Set d = d0.CurrentRegion 'd = все смежные с d0 ячейки
    Set d = d.Offset(1).Resize(d.Rows.Count - 1) 'd = все, кроме шапки
    With ActiveSheet.Sort.SortFields 'сортируем
        .Clear 'убрать то, что было (не обязательно, но если не написать, то могут быть косяки)
        .Add Key:=d0, Order:=or_ 'какой столбец и как сортируем
        With .Parent '
            .SetRange d 'какой диапазон
            .Apply 'сам процесс сортировки
        End With
    End With
    d0.Select 'выделяем d0
    Application.ScreenUpdating = 1
End Sub

Set d0 = Selection(1) 'd0 - первая ячейка выделенного диапазона на листе

Sub Кнопка1_Щелчок()
   Range("B3").Select
   Sortir
End Sub

    Set d = d.Offset(1).Resize(d.Rows.Count - 1)

    Set d = d.Offset(2).Resize(d.Rows.Count - 2)