Sub CrearCarpetas()
 
ruta = InputBox("Ingresa la ruta donde quieres crear las carpetas")
celda = InputBox("Primera celda")
Range(celda).Select
Do While ActiveCell.Value <> ""
MkDir (ruta & "/" & ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
End Sub