Microsoft 365 Modification macro-arborescence d’un dossier et sous-dossier

Sub Result()
Dim L As Integer, IndewW As Integer
IndexW = 2                                                      ' init pointeur écriture
Sheets("Result").Range("A2:C1000").ClearContents                ' effacement table résultats
With Sheets("Arborecence trame actuel")
    DerLig = .Range("D65500").End(xlUp).Row
    For L = 2 To DerLig                                         ' pour toutes les lignes du tableau
        If .Cells(L, "C") <> "" Then
            Equipement = .Cells(L, "C")                         ' mémorise équipement
        End If
        If .Cells(L, "D") <> "" Then                            ' si marque présente
            Sheets("Result").Cells(IndexW, 1) = Equipement      ' on écrit équipement
            Sheets("Result").Cells(IndexW, 2) = .Cells(L, "E")  ' type
            Sheets("Result").Cells(IndexW, 3) = .Cells(L, "D")  ' marque
            If .Cells(L, "D") <> .Cells(L - 1, "D") Then        ' si changement de marque
                IndexW = IndexW + 2                             ' on saute deux lignes
            Else
                IndexW = IndexW + 1                             ' sinon une seule
            End If
        End If
    Next L
End With
End Sub