Como Crear carpetas y subcarpetas en macro

Mirando en el foro he encontrado el código que necesito, pero al analizar el código veo que el rango que toma es de una celda en específico y lo que necesito es de toda una columna. Al igual que el número de subcarpetas en el ejemplo hay solo 1 y yo necesito una Carpeta que tenga a su vez una sub carpeta y que esa subcarpeta tenga otra subcarpeta.

He modificado el código y en principio me crea las dos primeras divisiones, pero la tercera no. Además que necesito que me cree todas las carpetas de la tabla no solo de la celda.

Sub CREANDO()
Dim miRuta As String, miCarpeta As String, miSubcarp As String, misubsubcarp As String
'Eligo la ruta
miRuta = InputBox("Ruta de las Carpetas")
'el nombre de carpeta con la celda
miCarpeta = ActiveSheet.Range("C2")
'el nombre de subcarpeta con la celda
miSubcarp = ActiveSheet.Range("D2")
'el nombre de subsubcarpeta con la celda
misubsubcarp = ActiveSheet.Range("F2")
On Error Resume Next
'primero se crea la carpeta
MkDir miRuta & "\" & miCarpeta
'luego la subcarpeta
MkDir miRuta & "\" & miCarpeta & "\" & miSubcarp
'luego la subsubcarpeta
MkDir miRuta & "\" & miCarpeta & "\" & miSubcarp & "\" & misubsubcarp
MsgBox ("PROCESO COMPLETADO")
End Sub