Saltar al contenido

VBScript – Automáticamente crear carpetas en base a valores de celda en Excel

Teniendo una lista de valores / datos en Excel se pueden crear carpetas en base a valores de celda automáticamente.

Por ejemplo tuve que crear aproximadamente 350 carpetas con números de factura el cual obtuve en un reporte de Excel y guardar dentro su XML y PDF, por el momento y tiempo solo me centre en lo sencillo que es crear las carpetas en base a los datos de las celdas el cual son los números de factura.

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- Opcional modificar la linea 8 del código donde de puede especificar la ruta donde crear las carpetas, predeterminado toma la ruta donde esta guardado el Excel.

5.- Realizamos la selección de las celdas que tienen el nombre de las carpetas.

Muestra en Excel - Automáticamente crear carpetas en base a valores de celda en Excel

6.- Vamos al editor de Visual Basic y ejecutamos el Script (F5 o Directamente en la flecha verde).

Editor VB - Automáticamente crear carpetas en base a valores de celda en Excel

7.- Esperamos un tiempo pueden ser segundos o minutos dependiendo la cantidad y listo tendremos nuestras carpetas.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código para crear carpetas en base a valores de celda en Excel

VBScript que crea automáticamente carpetas en base a los valores de las celdas marcadas en Excel (Nombra la carpeta en base al dato que tiene cada celda y crea una carpeta por cada celda).

Sub CrearCarpetas()
Dim Rng As Range
Dim iMaxRows, iMaxCols, r, iC As Integer
Dim sRuta As String
Set Rng = Selection
maxRenglones = Rng.Rows.Count
maxColumnas = Rng.Columns.Count
sRuta = ActiveWorkbook.Path
    For iC = 1 To maxColumnas
    iR = 1
        Do While iR <= maxRenglones
            If Len(Dir(sRuta & "\" & Rng(iR, iC), vbDirectory)) = 0 Then
                MkDir (sRuta & "\" & Rng(iR, iC))
                On Error Resume Next
            End If
            iR = iR + 1
        Loop
    Next iC
End Sub

 

Te recomendamos leer: