Imprimir en un formato único, información de varias hojas
Agradezco de antemano a quien me pueda colaborar con la siguiente situación:
Tengo un archivo que contiene varias hojas, en una de ellas (Hoja13) hay un formato el cual se alimenta pasando a la celda C9 el ID que está contenido en otras hojas en rangos que van desde la celda B7 hasta la B56, este es el máximo que puede contener cada una de las hojas, los rangos son variables
A la Hoja Desprendible (Hoja13) en la celda C9, se debe de ir pasando uno por uno de los Id de las demás hojas para imprimir el formato (Hoja13) con la información de cada tercero, esto lo he logrado hacer con información de una sola hoja, lo que necesito es que poder recorrer todas las hojas e ir pasando a la celda C9 de la Hoja13, los Id que haya en la columna B desde B7 de cada una de las demás hojas, es decir que cuando recorra todo el contenido de B7 hasta donde haya datos, máximo B56 de una hoja, pase a la siguiente hoja y de igual manera pase a la Hoja13 celda C9 lo que haya en la columna B desde B7 y así sucesivamente hasta recorrer todas las hojas del archivo con excepción de la hoja2 (DATOS" y la hoja3 (POBLACION).
Para lo que he podido hacer con información de una sola hoja, utilizo el siguiente código:
Sub IMPRIMECTAPDF()
Dim r As Long
Dim n As Long
Application.ScreenUpdating = False
Hoja13.Visible = xlSheetVisible
Hoja13.Select
Hoja13.Unprotect "1717171"
n = Application.WorksheetFunction.CountA(Sheets("CAE").Range("B7:B56"))
If n = 0 Then Exit Sub
For r = 7 To (n + 1)
Hoja13.Range("C9") = Sheets("CAE").Range("B" & r)
Calculate
'Mostrar las filas ocultas
Rows("15:264").EntireRow.Hidden = False
'Ocultar Filas Vacias o en ceros
Dim Rg As Range
For Each Rg In Range("I16:I255")
If Rg.Value = "" Or Rg.Value = 0 Then
Rg.EntireRow.Hidden = True
Else
Rg.EntireRow.Hidden = False
End If
Next Rg
Call ImprimeCta
'Sheets("Desprendible").Select
'Sheets("Desprendible").Unprotect "1717171"
DoEvents
Next
MsgBox "Impresion finalizada", vbInformation
'Sheets("Desprendible").Protect "1717171"
'ActiveWorkbook.Protect "1717171"
End SubAdjunto imágenes del libro
2 respuestas
Puedes utilizar el siguiente código:
Sub IMPRIMECTAPDF()
Dim wsDesprendible As Worksheet
Dim wsDatos As Worksheet
Dim r As Long
Dim n As Long
Application.ScreenUpdating = False
' Desproteger la hoja Desprendible
Set wsDesprendible = ThisWorkbook.Sheets("Hoja13")
wsDesprendible.Visible = xlSheetVisible
wsDesprendible.Unprotect "1717171"
' Recorrer las hojas
For Each wsDatos In ThisWorkbook.Sheets
' Excluir las hojas "DATOS" y "POBLACION"
If wsDatos.Name <> "DATOS" And wsDatos.Name <> "POBLACION" Then
' Contar el número de celdas con datos en la columna B de la hoja actual
n = wsDatos.Range("B7:B56").Cells.SpecialCells(xlCellTypeConstants).Count
' Verificar si hay datos en la columna B
If n > 0 Then
' Recorrer los ID en la columna B de la hoja actual
For r = 7 To (n + 6)
wsDesprendible.Range("C9") = wsDatos.Range("B" & r).Value
Calculate
' Mostrar las filas ocultas
wsDesprendible.Rows("15:264").EntireRow.Hidden = False
' Ocultar filas vacías o en ceros
Dim Rg As Range
For Each Rg In wsDesprendible.Range("I16:I255")
If Rg.Value = "" Or Rg.Value = 0 Then
Rg.EntireRow.Hidden = True
Else
Rg.EntireRow.Hidden = False
End If
Next Rg
' Imprimir el formato
Call ImprimirCta
DoEvents
Next r
End If
End If
Next wsDatos
' Volver a proteger la hoja Desprendible
wsDesprendible.Protect "1717171"
Application.ScreenUpdating = True
MsgBox "Impresión finalizada", vbInformation
End Sub
Hola Rafael muy buen día:
Primero que todo muchas gracias por su respuesta, estoy utilizando el código que me envía, pero no me lleva los Id de cada hoja, la linea que debe de hacer ese proceso me da vacío, como puedo al ejecutar paso a paso validar de que hoja esta tomando la información?, adjunto imagen:
Se debe a que la hoja en la que estás intentando establecer un valor en la celda C9 no está activa en ese momento. Puedes solucionar este problema utilizando el método Activate antes de asignar el valor a la celda. Aquí está la línea modificada que puedes usar:
Corregido el código:
Sub IMPRIMECTAPDF()
Dim wsDesprendible As Worksheet
Dim wsDatos As Worksheet
Dim r As Long
Dim n As Long
Application.ScreenUpdating = False
' Desproteger la hoja Desprendible
Set wsDesprendible = ThisWorkbook.Sheets("Hoja13")
wsDesprendible.Visible = xlSheetVisible
wsDesprendible.Unprotect "1717171"
' Recorrer las hojas
For Each wsDatos In ThisWorkbook.Sheets
' Excluir las hojas "DATOS" y "POBLACION"
If wsDatos.Name <> "DATOS" And wsDatos.Name <> "POBLACION" Then
' Contar el número de celdas con datos en la columna B de la hoja actual
n = wsDatos.Range("B7:B56").Cells.SpecialCells(xlCellTypeConstants).Count
' Verificar si hay datos en la columna B
If n > 0 Then
' Recorrer los ID en la columna B de la hoja actual
For r = 7 To (n + 6)
If Not wsDatos.ProtectContents Then
wsDatos.Activate
wsDesprendible.Range("C9").Value = wsDatos.Range("B" & r).Value
Calculate
' Mostrar las filas ocultas
wsDesprendible.Rows("15:264").EntireRow.Hidden = False
' Ocultar filas vacías o en ceros
Dim Rg As Range
For Each Rg In wsDesprendible.Range("I16:I255")
If Rg.Value = "" Or Rg.Value = 0 Then
Rg.EntireRow.Hidden = True
Else
Rg.EntireRow.Hidden = False
End If
Next Rg
' Imprimir el formato
Call ImprimirCta
DoEvents
End If
Next r
End If
End If
Next wsDatos
' Volver a proteger la hoja Desprendible
wsDesprendible.Protect "1717171"
Application.ScreenUpdating = True
MsgBox "Impresión finalizada", vbInformation
End SubAl activar la hoja "wsDatos" antes de establecer el valor en la celda C9 de la hoja "wsDesprendible", te aseguras de que estás tomando la información de la hoja correcta.
Además, te sugiero agregar una verificación adicional para asegurarte de que la hoja "wsDatos" no esté protegida antes de intentar establecer el valor. Puedes usar la propiedad "ProtectContents" para realizar esta verificación.
Revisa el siguiente ejemplo, es similar a lo que necesitas y lo puedes tomar como base para crear tu macro:
Curso de macro. Generar archivo y enviar correo en automatico. - YouTube
Otras recomendaciones:
Curso de macros. Generar archivos en automatico. - YouTube
Sal u dos Dante Amor
Muchas gracias por la respuesta, he revisado los videos que me sugiere, pero no es lo que necesito, la alimentación de los campos del formato la tengo solucionada, solo que lo he logrado con información de una sola hoja, y es precisamente el inconveniente que poseo, que no se como hacer para que a la celda C9 de la Hoja13 que es la hoja donde esta el formato, se vaya pasando uno a uno de los Id contenidos en la columna B de cada uno de las demás hojas, para eso utilizo este código:
n = Application.WorksheetFunction.CountA(Sheets("CAE").Range("B7:B56"))
If n = 0 Then Exit Sub
For r = 7 To (n + 1)
Hoja13.Range("C9") = Sheets("CAE").Range("B" & r)
En este caso CAE es el nombre de la hoja, por eso solo trabaja en esa hoja, lo que necesito es lograr que cuando termine de procesar la información de la hoja CAE, pase a la hoja CIP y haga lo mismo, cuando termine de procesar la información de esa hoja pase a la siguiente y haga lo mismo y así sucesivamente hasta que recorra todas las hojas del archivo.