Sub Макрос1()
    Dim Rng As Range, FilteredRng As Range, LastRow As Long
 
    With Worksheets("AllData")
        If .AutoFilterMode = False Then
            .Rows(1).AutoFilter
        Else
            If .FilterMode = True Then .ShowAllData
        End If
         
        Worksheets("Sort").Cells.Clear
         
        .UsedRange.AutoFilter Field:=2, Criteria1:="=" & .Range("B1"), Operator:=xlOr, Criteria2:="=" & .Range("C1")
        With .AutoFilter.Range
            If .Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                Set FilteredRng = .Rows.SpecialCells(xlCellTypeVisible)
                FilteredRng.Copy Worksheets("Sort").Cells(1, 1)
            End If
        End With
        .ShowAllData
        .UsedRange.AutoFilter Field:=3, Criteria1:="=" & .Range("B1"), Operator:=xlOr, Criteria2:="=" & .Range("C1")
        With .AutoFilter.Range
            If .Resize(.Rows.Count, 1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                Set FilteredRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
                With Worksheets("Sort")
                    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    FilteredRng.Copy Worksheets("Sort").Cells(LastRow + 1, 1)
                End With
            End If
        End With
        .ShowAllData
        Range("A1").Select
    End With
       
    With Worksheets("Sort")
        'удаляем дубликаты
        .UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
            7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, _
            34, 35, 36), Header:=xlYes
        
        'сортируем
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange .Parent.UsedRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    MsgBox "Данные на лист Sort скопированы!", vbInformation, "Конец"
End Sub

Sub MacroAdo()
Dim oRecordSet As Object, oConn As Object, C1 As String, C2 As String, F, i As Integer
Sheets("Sort").Cells.ClearContents
C1 = Sheets("AllData").Range("b1")
C2 = Sheets("AllData").Range("c1")
    Set oRecordSet = CreateObject("ADODB.Recordset")
    Set oConn = CreateObject("ADODB.Connection")
    sSQL_text = "SELECT * FROM `Alldata$` WHERE `" & C1 & "`='" & C1 & "' OR `" & C1 & "`='" & C2 & "' OR `" & _
    C2 & "`='" & C1 & "' OR `" & C2 & "`='" & C2 & "'"
    sConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
    oConn.Open sConnStr
    oRecordSet.Open sSQL_text, oConn
    ActiveWorkbook.Sheets("Sort").Range("A2").CopyFromRecordset oRecordSet
    For Each F In oRecordSet.Fields
        i = i + 1
        If F.Name <> C1 And F.Name <> C2 Then ActiveWorkbook.Sheets("Sort").Cells(1, i) = F.Name
    Next
End Sub