Фильтр Excel VBA CritiriaRange

Question

Я хочу отфильтровать 2 столбца из моего листа (B и C) и созданного кода, чтобы сделать это, но хочу упростить изменение критериев фильтрации.

Я создал следующее:

Sub test()

Application.DisplayAlerts = False
Dim Mh As String
Mh = ActiveSheet.Name 'Month name

'Add en Rename ActiveSheet
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test " & Mh

'Filter Ranges
 Range("A1").Select
 Sheets("October").Range("A1:F999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Filters").Range("A1:B2"), CopyToRange:=Range("A1:F1"), Unique:=False

End Sub

Мне бы хотелось, чтобы что-то подобное можно было изменить в именах файлов:

ActiveSheet.Range("A2:F999").AutoFilter Field:=2, Criteria1:="WABO"
ActiveSheet.Range("A2:F999").AutoFilter Field:=3, Criteria1:="Zuid"

Answer 1

Фильтр комбинированный

У вас есть лист, который вызывается через месяц.Вы добавляете новый лист к последнему посту и переименовываете его.Теперь вы можете ссылаться на него с помощью Sheets(Sheets.Count) или Sheets("Test " & Mh) или ActiveSheet.Я выбрал первый путь.Затем вы копируете специально отфильтрованный диапазон (фильтры из листа Filters) из исходного листа на новый лист.Вы применяете дополнительные 2 фильтра на диапазон.

Sub test()

  Const cStr2 = "WABO"
  Const cStr3 = "Zuid"

  Application.DisplayAlerts = False

  Dim Mh As String

  Mh = ActiveSheet.Name 'Month name

  'Add and Rename ActiveSheet
  Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Test " & Mh

  With Sheets(Sheets.Count)
    'Filter Ranges
     Sheets(Mh).Range("A1:F999").AdvancedFilter Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("Filters").Range("A1:B2"), _
         CopyToRange:=.Range("A1:F1")
    .Range("A2:F999").AutoFilter Field:=2, Criteria1:=cStr2
    .Range("A2:F999").AutoFilter Field:=3, Criteria1:=cStr3
  End With

  Application.DisplayAlerts = True

End Sub