crear carpetas desde excel

[3pies]

Aquí lo tienes:

Código:

Sub Crear_carpetas()
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'llamamos al objeto FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'pasamos a una variable, la ruta donde se encuentra el fichero de excel
'donde se está ejecutando este código
ruta = ActiveWorkbook.Path
'seleccionamos la primera celda que contiene los nombre de las
'carpetas (suponemos que es A4)
Range("A4").Select
'recorremos toda la columna, hasta que encuentre una fila vacía, y
'por cada fila con texto, crearemos una carpeta con el nombre de ese mismo texto
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
    'si la carpeta no existe, entonces la creamos
    If Not fso.FolderExists(ruta & "\" & ActiveCell.Value) Then
        fso.CreateFolder (ruta & "\" & ActiveCell.Value)
    End If
    'pasamos a la fila siguiente, y volvemos a recorrer el bucle
    ActiveCell.Offset(1, 0).Select
Loop
'limpiamos el objeto
Set fso = Nothing
'Mostramos el procedimiento
Application.ScreenUpdating = True
End Sub

Salu2