Macro para generar archivos con pie de página
Tengo que hacer una macro para que un archivo genere varios, dependiendo de un filtro, es decir, que separe en archivos distintos y agrupe según un criterio (valor de celda) determinado. Luego de ello, debe generar dos archivos, uno en excel y uno en PDF pero con la siguiente salvedad... Si el total de líneas que coincidan con el criterio es superior a 12, debe generar una hoja nueva (los nombres de hojas no influyen), es decir, si las coincidencias para el criterio 1 son 10, solo genera una hoja con los 10 registros, pero si son 25, deberá generar 3 hojas en el mismo archivo con nombres a definir pero que todas las hojas deben tener el pie de página...
1 respuesta
Para hacer la macro, me faltan varios datos.
- En cuál celda vas a poner el número de caja, ¿entonces la macro leerá ese número de caja y solamente generará los archivos que correspondan a ese número de caja?
- ¿Qué datos se deben pasar de la hoja "Hoja1" a la hoja "FORMATO_IMP"?
- Se van a generar 2 archivos. ¿Cómo se va a llamar el archivo de excel y cómo se va a llamar el archivo pdf?
Dante. Adjunto las respuestas.
En cuál celda vas a poner el número de caja, ¿entonces la macro leerá ese número de caja y solamente generará los archivos que correspondan a ese número de caja?
Resp: Exacto. La celda a leer es la C5 de la hoja FORMATO_IMP. La idea es que la macro lea ese número y efectue el filtro necesario en la hoja Hoja1 del archibo BASE_TE. Debe generar un solo archivo por cada numero, pero con N cantidad de hojas, ya que solo pueden tener 12 lineas cada hoja.
¿Qué datos se deben pasar de la hoja "Hoja1" a la hoja "FORMATO_IMP"?
Resp: Deben pasar los datos de resultado del filtro, de las columnas B, C y D
Se van a generar 2 archivos. ¿Cómo se va a llamar el archivo de excel y cómo se va a llamar el archivo pdf?
Resp: Deben tener el mismo nombre, el cual debe ser dado por el número de caja, por ejemplo "CAJA_00001.xls", "CAJA_00002.xls", "CAJA_00001.pdf", "CAJA_00002.pdf"etc.
Muchas gracias!!
Te anexo la macro
Sub Generar_Archivos()
'-------
' Por.Dante Amor
'-------
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("FORMATO_IMP")
ruta = l1.Path & "\"
'
caja = h2.[C5]
If caja = "" Then
MsgBox "Falta el número de caja"
Exit Sub
End If
'
Set b = h1.Columns("A").Find(caja, lookat:=xlWhole)
If b Is Nothing Then
MsgBox "No existe el número de caja"
Exit Sub
End If
'
h2.Copy
Set l2 = ActiveWorkbook
Set h21 = l2.Sheets(1)
'
n = 1
j = 9
Set r = h1.Columns("A")
Set b = r.Find(caja, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If n = 13 Then
n = 1
j = 9
h2.Copy after:=l2.Sheets(l2.Sheets.Count)
Set h21 = l2.ActiveSheet
End If
h1.Range("B" & b.Row & ":D" & b.Row).Copy
h21.Range("B" & j).PasteSpecial xlValues
j = j + 1
n = n + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
archivo = "CAJA_" & Format(caja, "00000")
l2.SaveAs Filename:=ruta & archivo & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & archivo & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
l2.Close
MsgBox "Archivos creados"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
