Sub Макрос3()
    Cells.AutoFilter Field:=1, Criteria1:="5"
    Cells.AutoFilter Field:=20, Criteria1:="упр."
    Dim v
    ActiveSheet.UsedRange.Copy
    Sheets.Add
    ActiveSheet.Paste
    v = ActiveSheet.UsedRange.Rows(2).Value
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Cells.AutoFilter
End Sub

Function Sashagor(WS As Worksheet, Field, Criteria)
For i = 0 To UBound(Field)
  WS.Cells.AutoFilter Field(i), Criteria(i)
Next
Sashagor = WS.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2).Value
WS.Cells.AutoFilter
End Function

Sub Example()
c1 = [d:d].Column: c2 = [w:w].Column
numer = "5": podr = "упр."
v = Sashagor(Worksheets("Лист1"), Array(c1, c2), Array(numer, podr))
MsgBox v(1, 4) & " | " & v(1, 23)
End Sub

Sub еее()
    numer = 5
    podr = "упр."
    With Sheets(1) 'указать свой лист
        lr = .Cells(Rows.Count, "d").End(xlUp).Row
        Dim rng, arr(), i&, k&
        rng = .Range("d1:w" & lr).Value
        For i = 1 To lr
            If rng(i, 1) = numer And rng(i, UBound(rng, 2)) = podr Then
                ReDim Preserve arr(k)
                arr(k) = Intersect(.Rows(i), .UsedRange).Value: k = k + 1
            End If
        Next i
    End With
    'Вывод на 2-й лист
    For i = 0 To UBound(arr)
        Sheets(2).Cells(i + 1, 1).Resize(, UBound(arr(i), 2)) = arr(i)
    Next i
End Sub

Sub tt()
    ar1 = Range("D2:D20000")
    ar2 = Range("W2:W20000")
    For i = LBound(ar1) To UBound(ar1)
        ar1(i, 1) = ar1(i, 1) & ar2(i, 1)
    Next i
    n_ = WorksheetFunction.Match("5упр.", ar1, 0) + 1
End Sub

    Dim col, rws As Integer
    
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False

    Dim list As String

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Range(Cells(1, col + 5), Cells(Cells(Rows.Count, col + 8).End(xlUp).Row, 2 * col + 5)).Copy Destination:=Cells(1, 1)

    Dim list As String
    Dim col, rws, i As Integer

    list = ActiveSheet.Name
    Sheets.Add After:=Sheets(Sheets.Count)
    Worksheets(list).Cells.Copy Destination:=ActiveSheet.Cells
    col = ActiveSheet.UsedRange.Columns.Count
    rws = ActiveSheet.UsedRange.Rows.Count
    Cells(1, 4).Copy Destination:=Cells(1, col + 2)
    Cells(2, col + 2).Value = numer
    Cells(1, 23).Copy Destination:=Cells(1, col + 3)
    Cells(2, col + 3).Value = podr
    Range(Cells(1, 1), Cells(rws, col)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(1, col + 2), Cells(2, col + 3)), CopyToRange:=Cells(1, col + 5), Unique:=False
    For i = 1 To col + 4
        Columns(1).Delete
    Next i