[a_axe]

surgutfred, на форуме обсуждалась похожая тема с удобным решением 2010 - [решено] Фильтр таблицы по стороннему столбцу с данными Excel пост 7.
Посмотрите, если решение вас не устроит или появятся вопросы - отпишитесь.

[surgutfred]

a_axe, это удобно когда у тебя 2-3 условия для фильтра, а у меня список условий для отбора до 100 может быть, данный инструмент не удобен

[a_axe]

у меня список условий для отбора до 100 может быть, данный инструмент не удобен »

surgutfred, тут важно пояснить, какой функционал нужно адаптировать, чтобы решения стало удобным. Если вопрос только в количестве фильтров - возьмите ваш файл пример, нажмите сочетание alt+f11 для открытия VBA редактора, в "дереве проекта" найдите ярлычок Лист2(Условия), дважды щелкните по нему, чтобы в основном окне открылось его содержимое (белый лист). Скопируйте туда код ниже (чуть-чуть адаптированная версия кода из указанной темы). Вбейте в список листа "Условия" новое имя (пустых строчек быть не должно, имена должны идти подряд). Листы должны быть названы в соответствии с вашим примером.

Код:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2").Resize(Range("A2").CurrentRegion.Columns.Item(1).Rows.Count-1)) Is Nothing Then
        On Error Resume Next
        Sheets.Item("Данные").ShowAllData
        Sheets.Item("Данные").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
    End If
End Sub

[surgutfred]

a_axe, Спасибо, то что нужно, только вместо Sheets.Item("Данные"). сделал Sheets(1).Range("A1") т.к. имя листа постоянно по дате меняется.
Единственное неудобство, когда очищаешь условие отбора, он задумывается в попытке обработать, курсор крутится. Esc спасает, но может есть вариант не обрабатывать событие, если нет введенных условий?

[a_axe]

вариант не обрабатывать событие, если нет введенных условий? »

Не обрабатывать пустой диапазон можно, но тогда не ясно, по какому событию на листе Данные будет убран фильтр.
В коде ниже фильтр убирается, если в А2 вбить значение "Все", пробуйте.

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim shtObj As Worksheet
    Set shtObj = Sheets.Item(1)
    If Not Intersect(Target, Range("A2").Resize(Range("A2").CurrentRegion.Columns.Item(1).Rows.Count - 1)) Is Nothing And Range("A1").CurrentRegion.Rows.Count > 1 Then
        On Error Resume Next
        shtObj.ShowAllData
        shtObj.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
    End If
    If LCase(Range("A2").Value) = "все" Then shtObj.ShowAllData
    Set shtObj = Nothing
End Sub

[surgutfred]

a_axe, спасибо, тогда проще ESC жать