Něco jako tohle:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Radek As Long
Application.ScreenUpdating = False
If Target.Column = 2 Then
Radek = Cells(Rows.Count, "B").End(xlUp).Row
Range("A1:B" & Radek).Sort Key1:=Range("B1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Application.ScreenUpdating = True
End Sub