Sub Niveaux()
Dim plage As Range, dep As Range, restit As Range
Dim t$, s, i%, Nmax%, cel As Range, n%
Set plage = [A2:A15] 'à adapter
Set dep = [C2] 'à adapter
Set restit = [A18] 'à adapter
t = "La cellule " & dep.Address(0, 0) & " doit contenir des nombres séparés par des points..."
'---vérifications---
If IsEmpty(dep) Then MsgBox t: Exit Sub
s = Split(dep, ".")
For i = 0 To UBound(s)
If Not IsNumeric(s(i)) Then MsgBox t: Exit Sub
Next
'---initialisation---
Application.ScreenUpdating = False
dep(2).Resize(Rows.Count - dep.Row, Columns.Count - dep.Column + 1).Clear
restit.Resize(Rows.Count - restit.Row + 1).Clear
Set cel = dep
dep.Copy restit(1)
For i = 2 To plage.Count
'---détermination du niveau---
Nmax = Cells(cel.Row, Columns.Count).End(xlToLeft).Column - dep.Column + 2
n = Abs(Val(plage(i)))
If n = 0 Then n = 1
If n > Nmax Then n = Nmax
'---création du niveau---
Set cel = Cells(cel.Row + 1, n + dep.Column - 1)
dep.Copy cel
If n = Nmax Then
cel = cel(0, 0) & ".1"
Else
t = cel.EntireColumn.Find("*", cel, , , , xlPrevious)
s = Split(t, ".")
s(UBound(s)) = s(UBound(s)) + 1
cel = Join(s, ".")
End If
cel.Copy restit(i)
Next
End Sub