фильтр (vba excel)

Sub P2()
Dim Лист1 As Excel.Worksheet
Dim Временный As Excel.Worksheet
Dim LastRow As Long
Dim LastColomn As Long
Dim oFind As Excel.Range
Dim АдресПоиск As String
Dim АдресОбъединённых As String
Set Лист1 = ActiveWorkbook.Worksheets("Лист1")
With Лист1.UsedRange
    LastRow = .Rows.Count
    LastColomn = .Columns.Count
End With
With Лист1.Range(Лист1.Cells(1, 1), Лист1.Cells(LastRow, LastColomn))
    Application.FindFormat.Clear
    Application.FindFormat.MergeCells = True
    Set oFind = .Find(what:="", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, Searchformat:=True)
    If Not oFind Is Nothing Then
        АдресПоиск = oFind.Address
        Set Временный = ActiveWorkbook.Worksheets.Add
        Do
            АдресОбъединённых = oFind.MergeArea.Address
            oFind.MergeArea.Copy
            Лист1.Paste Destination:=Временный.Range("A1")
            oFind.MergeArea.UnMerge
            Лист1.Range(АдресОбъединённых).Value = Временный.Range("A1")
            Временный.Range("A1").MergeArea.Copy
            oFind.PasteSpecial xlPasteFormats
            Временный.Cells.Clear
            Временный.Cells.UnMerge
            Set oFind = .Find(what:="", After:=oFind, Searchformat:=True)
        Loop While Not oFind Is Nothing And oFind.Address <> АдресПоиск
    End If
End With
Application.DisplayAlerts = False
Временный.Delete
Application.DisplayAlerts = True
Application.FindFormat.Clear
End Sub

Sub AutoFil()
' запись макроса автофильтра с выбором множественных значений (больше 2)
    Sheets(1).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$AF$77").AutoFilter Field:=2, Criteria1:=Array( _
        "запись 1", "запись 13", "запись 3", "запись 6"), Operator:= _
        xlFilterValues
End Sub

    Dim ValueArr() ' массив значений
'    ...
'   тут заполнение массива ValueArr
'   ...
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$AF$77").AutoFilter Field:=2, Criteria1:=ValueArr, Operator:= _
        xlFilterValues

Sub AutoFil()
    Dim i As Integer, s As Integer
    Dim ValueArr()
    s = 0
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            ReDim Preserve ValueArr(0 To s)
            ValueArr(s) = Me.ListBox1.List(i)
            s = s + 1
        End If
    Next i
 
'    ...
 
    Selection.AutoFilter
    ActiveSheet.Range(AF_Range).AutoFilter _
        Field:=Me.ComboBox2.ListIndex, _
        Criteria1:=ValueArr, _
        Operator:= xlFilterValues
 
End Sub

ReDim Preserve a(1 to 10) As String

Dim ValueArr() As Variant
 
ValueArr = Array("Val1", "Val2", "Val3") 
Selection.AutoFilter
ActiveSheet.Range(AF_Range).AutoFilter _
    Field:=Me.ComboBox2.ListIndex, Criteria1:=ValueArr, _
    Operator:= xlFilterValues

Sub zapros()
'
' zapros
'
    Range("A1:A3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Names.Add Name:="MyTabl", RefersToR1C1:="=СВОД!R1C1:R77C32" 
    Workbooks.Add
    Windows("СВОД.xls").Activate
    Windows("Книга1").Activate
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DSN=Excel Files;DBQ=D:\MyPath\СВОД.xls;DefaultDir=D:\MyPath;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT MyTabl.`№п.п`, MyTabl.`Организация`, MyTabl.Сумма" & Chr(13) & "" & Chr(10) & "FROM `D:\MyPath\СВОД.xls`.MyTabl MyTabl" & Chr(13) & "" & Chr(10) & "WHERE (MyTabl.`Организация`='Орг 1') OR (MyTabl.`Организация`='Орг 1')" & Chr(13) & "" & Chr(10) & "ORDER BY MyTabl.`Организация`")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Query_запрос_из_Excel_Files"
        .Refresh BackgroundQuery:=False
    End With
End Sub