Recherche et transposition automatique par macro

Bonjour à tous,

Je sollicite votre aide afin de savoir ce qu'il serait possible de faire pour effectuer une recherche de numéro ntp dans "feuil0" correspondant à un numéro dans "feuil1" puis transposer les rubriques affichées en colonne correspondantes de la "feuil1" en ligne dans la "feuil0" le tout trier dans l'ordre croissant.

Je précise que les numéro "ntp" dans chaque colonne A de "feuil1" et "feuil0" ne sont pas forcément dans le même ordre.

Pour résumer, je pensais à une macro qui balaye chaque ligne de la colonne A de feuil1 (en partant de A2). Tant qu'il y a le même numéro, on met en mémoire les rubriques correspondantes pour aller les afficher en ligne dans l'ordre croissant sur "feuil0" au bon endroit.

Je mets mon fichier d'exemple en pièce jointe. Je coince car il faut partir d'une base de données en colonne pour l'afficher en ligne sur une autre feuille.

Je remercie par avance les personnes qui pourront m'aider.

bonjour,

une proposition via une macro

Sub aargh()
    Dim t, tr()
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        t = .Range("A2:C" & dl)
        ncm = 2
        nl = 1
        oldt = ""
        i = 1
        ReDim Preserve tr(1 To 10000, 1 To ncm)
        While i <= dl - 1
            If t(i, 1) = oldt Then
                nc = nc + 1
                If nc > ncm Then ncm = nc: ReDim Preserve tr(1 To 10000, 1 To ncm)
                tr(nl, nc) = t(i, 3)
            Else
                For j = 2 To nc - 1
                    For k = j + 1 To nc
                        If tr(nl, j) > tr(nl, k) Then a = tr(nl, j): tr(nl, j) = tr(nl, k): tr(nl, k) = a
                    Next k
                Next j

                nl = nl + 1
                tr(nl, 1) = t(i, 1)
                tr(nl, 2) = t(i, 3)
                nc = 2
                oldt = t(i, 1)
            End If
            i = i + 1
        Wend
        Sheets("feuil0").Range("A1").Resize(nl, ncm) = tr
    End With
End Sub

Merci beaucoup pour cette macro h2so4. Elle fonctionne très bien!

En complément, serait il possible d'afficher en ligne sur "feuil0" les numéro de rubrique dans un ordre croissant?

Je vais aussi essayer de mon côté d'assimiler ta macro pour tenter d'inclure ce tri croissant dans l'affichage.

re-bonjour,

macro adaptée pour faire un tri numérique, plutot qu'un tri alphanumérique

Sub aargh()
    Dim t, tr()
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        t = .Range("A2:C" & dl)
        ncm = 2
        nl = 1
        oldt = ""
        i = 1
        ReDim Preserve tr(1 To 10000, 1 To ncm)
        While i <= dl - 1
            If t(i, 1) = oldt Then
                nc = nc + 1
                If nc > ncm Then ncm = nc: ReDim Preserve tr(1 To 10000, 1 To ncm)
                tr(nl, nc) = Val(t(i, 3))
            Else
                For j = 2 To nc - 1
                    For k = j + 1 To nc
                        If tr(nl, j) > tr(nl, k) Then a = tr(nl, j): tr(nl, j) = tr(nl, k): tr(nl, k) = a
                    Next k
                Next j

                nl = nl + 1
                tr(nl, 1) = t(i, 1)
                tr(nl, 2) = Val(t(i, 3))
                nc = 2
                oldt = t(i, 1)
            End If
            i = i + 1
        Wend
        Sheets("feuil0").Range("A1").Resize(nl, ncm) = tr
    End With
End Sub

Super je vais gagner un temps fou!

Un GRAND merci. Je ferme le sujet