Arborescence de fournisseur

Bonjour à tous,

Je suis débutant sur VBA Excel et je dois faire un programme pour mon projet.

Pour faire simple, j'ai un fichier Excel avec tous les fournisseurs de mon entreprise de référencés. Ce fichier est composé de 3 pages (grands-parents, parents, enfants). Les grands parents sont les fournisseurs principaux, en dessous de lui nous pouvons retrouver plusieurs parents et en dessous de ces parents nous retrouvons encore plusieurs enfants. Je voudrais créer une macro me permettant d'établir une arborescence de ses fournisseurs sans utiliser la fonction viewtree dans les userforms. Je vous joint un exemple de fichier ci-joint afin de faciliter la compréhension du problème.

Merci d'avance

Cordialement,

Bonjour,

A tester si ça convient :

Sub TreeView()

    Dim FeResult As Worksheet
    Dim PlgGp As Range
    Dim PlgP As Range
    Dim PlgEnf As Range
    Dim CelGp As Range
    Dim CelP As Range
    Dim CelEnf As Range
    Dim I As Long
    Dim J As Long

    Set FeResult = Worksheets("Exemple d'arbo")

    'défini les plages
    With Worksheets("G-parents"): Set PlgGp = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    With Worksheets("Parents"): Set PlgP = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    With Worksheets("Child"): Set PlgEnf = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    'tris ascendants des plages
    PlgGp.Sort PlgGp(1), xlAscending
    Worksheets("Parents").Range(PlgP, PlgP.Offset(, 1)).Sort PlgP(1), xlAscending
    Worksheets("Child").Range(PlgEnf, PlgEnf.Offset(, 1)).Sort PlgEnf(1), xlAscending

    'supprime tout sur la feuille (bordures, coleurs, valeurs, etc...)
    FeResult.Cells.Clear

    I = 1

    For Each CelGp In PlgGp

        I = I + 1
        FeResult.Cells(I, 1).Value = CelGp.Value
        FeResult.Cells(I, 1).Interior.ColorIndex = 6

        For Each CelP In PlgP

            If CelP.Value = CelGp.Value Then

                J = J + 1
                FeResult.Cells(I + J, 2).Value = CelP.Offset(, 1).Value
                FeResult.Cells(I + J, 2).Interior.ColorIndex = 24

                For Each CelEnf In PlgEnf

                    If CelEnf.Value = CelP.Offset(, 1).Value Then

                        J = J + 1
                        FeResult.Cells(I + J, 3).Value = CelEnf.Offset(, 1).Value
                        FeResult.Cells(I + J, 3).Interior.ColorIndex = 40

                    End If

                Next CelEnf

                    I = I + J
                    J = 0

            End If

        Next CelP

        I = I + J
        J = 0

    Next CelGp

    'mise en place des bordures
    FeResult.UsedRange.Borders.LineStyle = xlContinuous

End Sub

C'est exactement ce que je souhaitais !

Merci beaucoup pour votre aide