Dim n, ligne, debOrg, Tbl()
Sub organigramme()
Tbl = Range("A2:B" & [A65000].End(xlUp).Row).Value
Set debOrg = [d1]
debOrg.Offset(1).Resize(25, 4).Clear
n = UBound(Tbl)
ligne = 0
For k = 1 To n
If Tbl(k, 2) = "" Then Ecrit Tbl(k, 1), 1, Tbl(k, 2)
Next k
End Sub
Sub Ecrit(parent, niv, comp) ' procédure récursive
ligne = ligne + 1
debOrg.Offset(ligne) = parent: debOrg.Offset(ligne, 1) = comp
For i = 1 To n
If Tbl(i, 2) = parent Then Ecrit Tbl(i, 1), niv + 1, Tbl(i, 2)
Next i
End Sub