Dim c&, r&

Sub Main()
    DirList ThisWorkbook.Path
End Sub

Sub DirList(Dstart As String)
    Dim startFold As Object, myFSO As Object
    Dim subFold, f, mainFold As String
    subFold = Array("e13", "e22", "i13") 'Массив ячеек, где вписаны подпапки
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    Dstart = Dstart & "\" & [e5]

    For Each f In subFold
        mainFold = Dstart & "\" & Range(f)
        Set startFold = myFSO.GetFolder(mainFold)
        r = Range(f).Row - 1: c = Range(f).Column - 1
        If Range(f).CurrentRegion.Columns.Count > 1 Then
            Range(f).CurrentRegion.Offset(, 1).Resize(, Range(f).CurrentRegion.Columns.Count - 1).ClearContents
        End If
        ScanFolder startFold
    Next f
End Sub

Sub ScanFolder(Fold As Object)
Dim fol As Object
    r = r + 1
    c = c + 1
    Cells(r, c) = Fold.Name
    For Each fol In Fold.SubFolders
        ScanFolder fol
    Next
    c = c - 1
End Sub