Not Filter exactly by clicking filter button

[avigorana]

Option Explicit

Private Sub btnFilter_Click()
    Application.ScreenUpdating = False
 
    ' clear old data first
    Dim n As Long
    n = Cells(Rows.Count, "A").End(xlUp).Row
    If n > 9 Then
        Rows("10:" & CStr(n)).Delete Shift:=xlUp
    End If
 
    With Sheets("Data")
        .Select
     
        ' apply filter
        .Range("A:I").AdvancedFilter Action:=xlFilterInPlace, criteriarange:=.Range("Criteria"), Unique:=False
     
        ' select filtered rows
        Dim rngFilter As Range
        Set rngFilter = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 9)
     
        ' count number of filtered rows
        On Error Resume Next
        n = 0
        n = rngFilter.SpecialCells(xlCellTypeVisible).Rows.Count
        On Error GoTo 0
     
        If n = 0 Then
            Sheets("Filter").Select
         
            ' skip copying
            GoTo skip_copying
        End If
     
        ' copy selection
        rngFilter.Select
        Selection.Copy
    End With
 
    ' paste new data
    Sheets("Filter").Select
    Sheets("Filter").Range("A10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Filter").Range("A10").Select

skip_copying:
    ' remove filter
    Sheets("Data").ShowAllData
 
    ' table style
    Sheets("Data").ListObjects("Table1").TableStyle = "TableStyleMedium2"
     
    Application.ScreenUpdating = True
End Sub

▬▬▬▬▬▬▬▬▬ Mod edit : thread moved to appropriate forum !

​