Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A2:A100")) Is Nothing Then A2A100Change Target: exit sub
  If Not Intersect(Target, Range("B2:B100")) Is Nothing Then B2B100Change Target: exit sub
End sub

Sub A2A100Change(Target as range)
  ' и тут пишите что нуно делать если изменения случились в А2:А100 (практически копируете код из Ваших процедур)
end sub

Sub B2B100Change(Target as range)
  ' и тут пишите что нуно делать если изменения случились в А2:А100
end sub

Private Sub Worksheet_Change(ByVal Target As Range)
   On Error Resume Next
   If Target.Cells.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("J5:J15005")) Is Nothing Then
       If Len(Target) = 11 Then
           Target.NumberFormat = "[<=9999999]###-##-##;# (###) ###-##-##"
       ElseIf Len(Target) = 10 Then
           Target.NumberFormat = "[<=9999999]###-##-##;8 (###) ###-##-##"
       ElseIf Len(Target) = 9 Then
           Target.NumberFormat = "[<=9999999]##-##-##;8 (0###) ##-##-##"
       End If
   End If
   If Target.Cells.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("L5:L15005")) Is Nothing Then
       If Len(Target) = 11 Then
           Target.NumberFormat = "[<=9999999]###-##-##;# (###) ###-##-##"
       ElseIf Len(Target) = 10 Then
           Target.NumberFormat = "[<=9999999]###-##-##;8 (###) ###-##-##"
       ElseIf Len(Target) = 9 Then
           Target.NumberFormat = "[<=9999999]##-##-##;8 (0###) ##-##-##"
       End If
   End If
'____________________________________________________
    
    Dim FilterCol As Integer
    Dim FilterRange As Range
    Dim CondtitionString As Variant
    Dim Condition1 As String, Condition2 As String
 
    If Intersect(Target, Range("A2:AA2")) Is Nothing Then Exit Sub
 
    On Error Resume Next
    Application.ScreenUpdating = False
     
    'определяем диапазон данных списка
    Set FilterRange = Target.Parent.AutoFilter.Range
     
    'считываем условия из всех измененных ячеек диапазона условий
    For Each cell In Target.Cells
        FilterCol = cell.Column - FilterRange.Columns(1).Column + 1
         
        If IsEmpty(cell) Then
            Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol
        Else
            If InStr(1, UCase(cell.Value), " ИЛИ ") > 0 Then
                LogicOperator = xlOr
                ConditionArray = Split(UCase(cell.Value), " ИЛИ ")
            Else
                If InStr(1, UCase(cell.Value), " И ") > 0 Then
                    LogicOperator = xlAnd
                    ConditionArray = Split(UCase(cell.Value), " И ")
                Else
                    ConditionArray = Array(cell.Text)
                End If
            End If
            'формируем первое условие
            If Left(ConditionArray(0), 1) = "<" Or Left(ConditionArray(0), 1) = ">" Then
                Condition1 = ConditionArray(0)
            Else
                Condition1 = "=" & ConditionArray(0)
            End If
            'формируем второе условие - если оно есть
            If UBound(ConditionArray) = 1 Then
                If Left(ConditionArray(1), 1) = "<" Or Left(ConditionArray(1), 1) = ">" Then
                    Condition2 = ConditionArray(1)
                Else
                    Condition2 = "=" & ConditionArray(1)
                End If
            End If
            'включаем фильтрацию
            If UBound(ConditionArray) = 0 Then
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1
            Else
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1, _
                    Operator:=LogicOperator, Criteria2:=Condition2
            End If
        End If
    Next cell
     
    Set FilterRange = Nothing
    Application.ScreenUpdating = True

'____________________________________________________


Dim NewCellValue$, OldComment$
Dim cell As Range
     
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Intersect(Target, Range("A5:AA15005")) Is Nothing Then Exit Sub
     
    'перебираем все ячейки в измененной области
    For Each cell In Intersect(Target, Range("A5:AA15005"))
        If IsEmpty(cell) Then
            NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки
        Else
            NewCellValue = cell.Formula     'или ее содержимое
        End If
        On Error Resume Next
         
        With cell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     'удаляем старое примечание (если было)
            .AddComment         'добавляем новое и вводим в него текст
            .Comment.Text Text:=OldComment & Application.UserName & " " & _
                            Format(Now, "MM.DD.YY h:MM:ss") & " : " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True    'делаем автоподбор размера
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell

End Sub