Extraire données selon arrivée

Bonjour le forum et bonne année à tous

Je cherche une macro pour extraie des données suivant l'arrivée d'une course et la recopier dans une autre plage.

je joint un fichier peut-etre plus explicite.

merci

Bonsoir jad73, le forum

A tester :

Option Explicit

Sub test()
Dim x(1 To 5), i As Byte, y, z
    With Sheets("Feuil1")
        With .Range("W1:AA1")
            For i = 1 To 5
                x(i) = .Cells(i).Address(0, 0)
            Next
        End With
        With .Cells(1).CurrentRegion.Resize(, 9)
            y = Filter(.Parent.Evaluate("transpose(if((" & .Columns(1).Address & "=" & x(1) & _
                ")+(" & .Columns(1).Address & "=" & x(2) & ")+(" & .Columns(1).Address & _
                "=" & x(3) & ")+(" & .Columns(1).Address & "=" & x(4) & ")+(" & .Columns(1).Address & _
                "=" & x(5) & "),row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            If UBound(y) = -1 Then
                MsgBox "Aucune donnée correspondante": Exit Sub
            End If
            z = Application.Index(.Value, Application.Transpose(y) _
                                          , Evaluate("column(" & .Rows(1).Address & ")"))
        End With
        If UBound(y) > 0 Then
            .Range("K2").Resize(UBound(z, 1), 9).Value = z
        Else
            .Range("K2").Resize(, UBound(z)).Value = z
        End If
    End With
End Sub

klin89

Bonjour Klin89, le forum

merci pour ta réponse. Le seul probleme c'est qu'elle ne recopie pas les données suivant l'ordre d'arrivée.

Hors il me faudrait qu'elles soient dans l'ordre d'arrivée, peut-on la modifier.

J'ai remis le fichier avec la macro.

merci

Re jad73,

Je pensais que ton problème était plus compliqué que ça.

Pas de doublons, peu de données.

Pour faire simple, un truc de ce genre :

De mémoire, parce que je ne peux pas ouvrir ton fichier.

Sub test()
    Dim c As Range, r As Range
    With Sheets("Feuil1")
       For Each c In .Range("W1:AA1")
          For Each r In .Range("A1:A10")
              If c = r Then
                  r.Resize(1, 9).Copy .Range("K65536").End(xlUp).Offset(1, 0)
                  Exit For
              End If
          Next
       Next
    End With
End Sub

A toi de peaufiner.

klin89