Activesheet.ListObjects("Таблица1").Sort.SortFields.Clear ' "Таблица1" - название таблицы
       Activesheet.ListObjects("Таблица1").Sort. _
           SortFields.Add Key:=Range("Таблица1[[#All],[Дата]]"), SortOn:= _
           xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers ' [Дата] - название поля в шапке таблицы
              
       With Activesheet.ListObjects("Таблица1").Sort
           .Header = xlYes
           .MatchCase = False
           .Orientation = xlTopToBottom
           .SortMethod = xlPinYin
           .Apply
       End With

Range("P5:S16").Select '"P5:S16") Диапазон, который будем сортировать
     Activesheet.Sort.SortFields.Clear
      Activesheet.Sort.SortFields.Add Key:=Range( _
          "P5:P16"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
          xlSortNormal ' Диапазон по которому нужно остсортировать
      With Activesheet.Sort
          .SetRange Range("P5:S16")
          .Header = xlGuess
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
      End With

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String, c As Long
        c = 1 '1 = нужный столбец c = Target.Column ' - для текущего столбца
        s = Cells(Target.Row, c).Text
            
        If c = Target.Column Then  'Если изменение в нужном столбце
            If Not Intersect(Target, Range("A:CF")) Is Nothing Then
                Range("a3:CF400").Sort Key1:=Cells(3, c) ' сортировка по столбцу изменения, чтобы сортировать по нужному столбцу вместо с - написать номер столбца.
            End If
                
            If Target.Value <> "" Then ' запуск поиска если не удаление
                Range(Cells(1, c), Cells(1000, c)).Find(What:=s, After:=Cells(1, c), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate
            End If
        End If
End Sub