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 Sub
Adjunto imágenes del libro