Как создать лист по названию критерии фильтра Excel если он меняется постоянно?

Sheets(1).Select
    ActiveSheet.ListObjects("Книга1").Range.AutoFilter Field:=2, Criteria1:= _
        "1-й"
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add Count:=1, After:=Sheets(2)
    ActiveSheet.Paste
    ActiveSheet.Name = "1-й"
    Columns("A:Q").Select
    Columns("A:Q").EntireColumn.AutoFit
    
    Sheets(1).Select
----------------
    ActiveSheet.ListObjects("Книга1").Range.AutoFilter Field:=2, [B]Criteria1:= _
        "1000-й"[/B]
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add Count:=1, After:=Sheets(1001)
    ActiveSheet.Paste
    ActiveSheet.Name = "1000-й"
    ActiveSheet.Paste
    Columns("A:Q").Select
    Columns("A:Q").EntireColumn.AutoFit
    Rows("1:100").Select
    Rows("1:100").EntireRow.AutoFit

Sub AutoFilterCriteria()
    Dim i As Integer
    i = 1: 'номер столбца автофильтра, который мы хотим проверить
    If ActiveSheet.AutoFilter.Filters(i).On Then MsgBox (ActiveSheet.AutoFilter.Filters(i).Criteria1) Else MsgBox ("В столбце " & i & " фильтр не активен")
End Sub

Sub AutoFilterCriteria()
    Dim i As Integer
    i = 1: 'номер столбца автофильтра, который мы хотим проверить
    If ActiveSheet.AutoFilter.Filters(i).On Then MsgBox (ActiveSheet.AutoFilter.Filters(i).Criteria1) Else MsgBox ("В столбце " & i & " фильтр не активен")
End Sub

Sub AutoFilterCriteria()
 
Dim i As Integer
i = 2: 
If Sheets(1).AutoFilter.Filters(i).On Then MsgBox (Sheets(1).AutoFilter.Filters(i).Criteria1) Else MsgBox ("В столбце " & i & " фильтр не активен")
End Sub