Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:I5")) Is Nothing Then
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("СПОРТ[Каталог]")) Is Nothing And Target.Cells.Count = 1 Then
        Application.EnableEvents = False
        newVal = Target
        Application.Undo
        oldVal = Target
        If Len(oldVal) <> 0 And oldVal <> newVal Then
            Target = Target & "," & newVal
        Else
            Target = newVal
        End If
        If Len(newVal) = 0 Then Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub