Finalmente conseguí lo que necesitaba. No he hecho muchas pruebas(por espacios en blanco o cosas asi), pero está bastante mejorado en relación al inicial.
Haciendo un par de validaciones, se puede agregar la opción de crear subcarpetas...y en fin, lo dejo aqui por si a alguien le es de utilidad.
![Aplauso](http://static.forosdelweb.com/fdwtheme/images/smilies/aplausos.gif)
Gracias a los codigos de 3pies y Taribo007 que sirvieron de modelo!
Código:
Sub Crear_carpetas()
Application.ScreenUpdating = False
contador = 0
Set fso = CreateObject("Scripting.FileSystemObject")
ruta = ActiveWorkbook.Path
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
Item = ActiveCell.Value
If Len(Item) = 1 Then
Item = "0" & Item
End If
ActiveCell.Offset(0, 1).Select
Codigo = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Nombre = ActiveCell.Value
Carpeta = Item & "-" & Codigo & "-" & Nombre
If Not fso.FolderExists(ruta & "\" & Carpeta) Then
fso.CreateFolder (ruta & "\" & Carpeta)
contador = contador + 1
End If
ActiveCell.Offset(1, -2).Select
Loop
Respuesta = MsgBox("Se han creado " & contador & " carpetas", 64, "Número de Carpetas")
Set fso = Nothing
Application.ScreenUpdating = True
End Sub