Cerca, estrai e copia

Option Explicit

Sub Cerca()
Application.ScreenUpdating = False
Dim NRg As Long, x As Long, k As Long
Dim y As Byte, z As Byte, w As Byte
Dim Vlr(5)

    For x = 1 To 5
        Vlr(x) = Cells(2, 11 + x)
    Next x
        NRg = Range("Y" & Rows.Count).End(xlUp).Row
            If NRg < 2 Then NRg = 2
        Range(Cells(2, 25), Cells(NRg, 29)).ClearContents
        
        NRg = Range("A" & Rows.Count).End(xlUp).Row
            k = 2
    For x = 3 To NRg
        z = 0
        Cells(x, 1).Select
            For y = 1 To 5
                For w = 1 To 5
                    If Cells(x, y).Value = Vlr(w) Then z = z + 1
                Next w
            Next y
        If z = 5 Then
            Range(Cells(x, 1), Cells(x, 5)).Copy Cells(k, 25)
                k = k + 1
        End If
    Next x
Application.ScreenUpdating = True
End Sub