Macro para generar varios archivos en PDF con nombre especifico

As) tengo una nueva duda... Que igual es grandota jaja

Tengo una macro, la cual me genera un archivo en PDF desde Excel, ejecutando ciertas ordenes, la cual me funciona re bien, sin problemas. Esta macro efectúa lo siguiente:

  1. Selecciona un rango y borra su contenido
  2. Selecciona un rango y elimina las lineas de formato de celda
  3. Aplica un filtro avanzado, copiando su resultado al sector borrado en el punto 1 (por eso se eliminan las lineas del formato, para que las pegue nuevas según corresponda)
  4. Selecciona las hojas necesarias para guardar el archivo (fue la única forma que encontré para que me guardara el archivo entero y no solo la hoja activa)
  5. Me guarda el archivo en PDF con un nombre especifico, digitado en una de las celdas
  6. Vuelve a la hoja y celda inicial.

El código de esta macro es:

Sub Final()
'
' Final Macro
'
'
ActiveWindow.LargeScroll ToRight:=-1
Range("A8:O14").Select
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B7").Select
Range("X7:AL492").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("X3:X4"), CopyToRange:=Range("A7:O14"), Unique:=True
Sheets(Array("HOJA_RUTA", "CARATULA", "VARIEDADES")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Jsantander\Documents\" & Range("BB2") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Range("X4").Select
Sheets("VARIEDADES").Select
Range("X4").Select
'
End Sub

El tema es el siguiente. Necesito que esta macro me genere los archivos que contenga el directorio, es decir, si son 20 empresas, que me genere los 20 archivos, con lo que corresponde a cada una de ellas... 20 no es mucha, pero la ultima vez fueron 240 archivos, por lo cual podrán imaginar que estar digitado el nombre, corriendo la macro, esperar que se ejecute y volver por el siguiente es una lata...

¿Se podrá lo indicado?

1 respuesta

Respuesta
3

Sí es posible, pero tengo estas dudas:

1. ¿Y de dónde se va tomando cada una de las 20 empresas?

2. ¿En cuál columna están las empresas?

3. ¿Y cuál es el nombre que va llevar cada archivo?

4. Por lo que veo el nombre lo toma de la celda BB2, ¿entonces qué se tendría que poner para cada empresa en esa celda?

5. Los datos que filtras en cuál hoja están, ¿en la de "VARIEDADES"?

Hola, muchas gracias. Mira, en el orden, seria:

  1. Existe un directorio en otro archivo. No es problema colocar una hoja nueva que muestre dicho directorio en el mismo archivo.
  2. La empresa esta en la columna X7, donde comienza el filtro avanzado.
  3. El nombre es el de la empresa. Es una concatenación con la región y el nombre de la empresa (Ejm: REGIÓN 1 - EMPRESA 001)
  4. Lo mismo expuesto en la pregunta 3, es una concatenación.
  5. Efectivamente los datos filtrados están en la Variedades.

Técnicamente, para ver si se puede entender un poco más, te comento: El archivo contiene 3 hojas.

  • HOJA_RUTA: Contiene solo información básica. Lo más complejo que tiene es un conteo de la cantidad de datos que tiene la hoja VARIEDADES con un "=contara(fila)"
  • CARATULA: Es una hoja con información solo buscada del directorio. Se busca la info mediante un "Buscarv" y se llenan los campos necesarios con la fórmula. El valor que se busca esta en la hoja de VARIEDADES y es el mismo que da origen al filtro avanzado.
  • VARIEDADES: Es la más compleja. En ella se encuentra el formulario propiamente tal, efectuando el filtro avanzado con una celda digitada (que es lo que quiero que sea automático) y genera el filtro, pegando los datos "al lado" (columna de al lado) y generando el nombre del archivo, el cual es la concatenación mencionada anteriormente.

Muchas gracias!

Puedes enviarme tu archivo para adaptar la macro, en el archivo me pones con algún color en dónde pones el dato para hacer el filtro avanzado.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Jorge” y el título de esta pregunta.

Enviado el correo estimado.

Slds.

Según tu ejemplo, en la hoja "VARIEDADES", en el rango "X7:AL7" tienes toda tu información. Si es así, entonces te anexo la macro.

Lo que hace la macro es seleccionar cada uno de los números únicos que aparecen en la columna X, lo pone en la celda X4, realiza el filtro y por último genera el pdf.

Sub Final()
'Act.Por.Dante Amor
' Final Macro
'
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    '
    u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    u2 = Range("X" & Rows.Count).End(xlUp).Row
    Columns("BD").Clear
    Range("X8:X" & u2).Copy Range("BD8")
    u3 = Range("BD" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("BD8:BD" & u3).RemoveDuplicates Columns:=1, Header:=xlNo
    n = 1
    '
    u4 = Range("BD" & Rows.Count).End(xlUp).Row
    For i = 8 To u4
        With Range("A8:O" & u)
            .ClearContents
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        '
        [X4] = Cells(i, "BD")
        Application.StatusBar = "Guardando archivo: " & n & " de: " & u4 - 7 & ". Nombre: " & Range("BB2")
        Range("X7:AL" & u2).AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("X3:X4"), CopyToRange:=Range("A7:O7"), Unique:=False
        '
        ruta = "C:\Users\Jsantander\Documents\PROYECTO CANASTA UNICA\BUSES\12062015\"
        'ruta = ThisWorkbook.Path & "\"
        Sheets(Array("HOJA_RUTA", "CARATULA", "VARIEDADES")).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ruta & Range("BB2") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        Sheets("VARIEDADES").Select
        n = n + 1
    Next
    '
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False
    MsgBox "Proceso terminado", vbInformation
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Hice algunos cambios simples y quedo impecable!!!! ¡Muchas Gracias! 

Si tienes dudas puedes solicitar más información, si la macro está excelente, ¿coméntame por qué la valoración solamente es buena?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas