Bom dia!!!

Veja se te ajuda, terá que adaptar!
Fonte:. http://www.ozgrid.com/Excel/excel-page-breaks.htm

Sub PrintAreaWithpageBreaks() 
Dim pages As Integer 
Dim pageBegin As String 
Dim PrArea As String 
Dim i As Integer 
Dim q As Integer 
Dim nRows As Integer, nPagebreaks As Integer 
Dim R As Range 
Set R = ActiveSheet.UsedRange 
'add pagebreak every 40 rows 
nRows = R.Rows.Count 
If nRows > 40 Then 
  nPagebreaks = Int(nRows / 40) 
  For i = 1 To nPagebreaks 
     ActiveWindow.SelectedSheets.HPageBreaks.Add  Before:=R.Cells(40 * i + 1, 1) 
  Next i 
End If 
'can be used in a separate macro, as I Start counting the number of pagebreaks 
pages = ActiveSheet.HPageBreaks.Count 
pageBegin = "$A$1" 
For i = 1 To pages 
  If i > 1 Then pageBegin = ActiveSheet.HPageBreaks(i - 1).Location.Address 
  q = ActiveSheet.HPageBreaks(i).Location.Row - 1 
  PrArea = pageBegin & ":" & "$H$" & Trim$(Str$(q)) 
  ActiveSheet.PageSetup.PrintArea = PrArea 
  ' the cell in column 1 and in the row immediately below the pagebreak 
  ' contains text for the footer 
  ActiveSheet.PageSetup.CenterFooter = Cells(q, 1) 
'  ActiveSheet.PrintOut copies:=1 
Next i 
End Sub

Alexandre , poderia por favor comentar esse código ; não entendo praticamente nada de VBA mas a tempos estou batalhando pra aprender e comentado é show pra isso

Bom dia!!

Sub PrintAreaWithpageBreaks()
Dim pages As Integer
Dim pageBegin As String
Dim PrArea As String
Dim i As Integer
Dim q As Integer
Dim nRows As Integer, nPagebreaks As Integer
Dim R As Range
Set R = ActiveSheet.UsedRange
'adicionar quebra de página a cada 40 linhas
nRows = R.Rows.Count
If nRows > 40 Then
  nPagebreaks = Int(nRows / 40)
  For i = 1 To nPagebreaks
     ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=R.Cells(40 * i + 1, 1)
  Next i
End If
'pode ser usado numa macro separada, Iníciando a contagem do número de quebras de página
pages = ActiveSheet.HPageBreaks.Count
pageBegin = "$A$1"
For i = 1 To pages
  If i > 1 Then pageBegin = ActiveSheet.HPageBreaks(i - 1).Location.Address
  q = ActiveSheet.HPageBreaks(i).Location.Row - 1
  PrArea = pageBegin & ":" & "$H$" & Trim$(Str$(q))
  ActiveSheet.PageSetup.PrintArea = PrArea
  ' A célula na coluna 1 e na linha imediatamente abaixo da página quebrada
  ' Contém o texto para o rodapé
  ActiveSheet.PageSetup.CenterFooter = Cells(q, 1)
'  ActiveSheet.PrintOut copies:=1
Next i
End Sub

Supondo que eu queira que ele quebre página com 40 linhas, mas, a partir da segunda, seja a cada 50, como ficaria o código acima?

Boa tarde!!

Veja e faça os teste

Option Explicit

Sub PrintAreaWithpageBreaks()
    Dim pages As Integer
    Dim pageBegin As String
    Dim PrArea As String
    Dim i As Integer
    Dim q As Integer
    Dim nRows As Integer, nPagebreaks As Integer
    Dim R As Range
    Set R = ActiveSheet.UsedRange
     'add pagebreak every 40 rows
    nRows = R.Rows.Count
    If nRows > 40 Then
    nPagebreaks = Int(nRows / 50)
    For i = 0 To nPagebreaks
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=R.Cells(50 * i + 40, 1)
    Next i
End If
    
     'can be used in a separate macro, as I Start counting the number of pagebreaks
    pages = ActiveSheet.HPageBreaks.Count
    pageBegin = "$A$1"
    For i = 1 To pages
        If i > 1 Then pageBegin = ActiveSheet.HPageBreaks(i - 1).Location.Address
        q = ActiveSheet.HPageBreaks(i).Location.Row - 1
        PrArea = pageBegin & ":" & "$H$" & Trim$(Str$(q))
        ActiveSheet.PageSetup.PrintArea = PrArea
         ' the cell in column 1 and in the row immediately below the pagebreak
         ' contains text for the footer
        ActiveSheet.PageSetup.CenterFooter = Cells(q, 1)
         '  ActiveSheet.PrintOut copies:=1
    Next i
End Sub

Boa tarde, alexandrevba.

Gostaria de saber se posso trocar "i" de "Dim i" por algum outro caracter, pois na macro que vou usar, conforme o código abaixo, já tem um "Dim i", só que com outros valores.

Olha meu código com adição do seu:

Sub Exibir()
'
' Exibir Macro
'
' Atalho do teclado: Ctrl+Shift+I
'
 Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="123"
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Dim pages As Integer
    Dim pageBegin As String
    Dim PrArea As String
    Dim i As Integer
    Dim q As Integer
    Dim nRows As Integer, nPagebreaks As Integer
    Dim R As Range
    Set R = ActiveSheet.UsedRange
    'add pagebreak every 40 rows
    nRows = R.Rows.Count
    If nRows > 40 Then
    nPagebreaks = Int(nRows / 35)
    For i = 0 To nPagebreaks
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=R.Cells(35 * i + 40, 1)
    Next i
    End If
     'can be used in a separate macro, as I Start counting the number of pagebreaks
    pages = ActiveSheet.HPageBreaks.Count
    pageBegin = "$A$1"
    For i = 1 To pages
        If i > 1 Then pageBegin = ActiveSheet.HPageBreaks(i - 1).Location.Address
        q = ActiveSheet.HPageBreaks(i).Location.Row - 1
        PrArea = pageBegin & ":" & "$H$" & Trim$(Str$(q))
        ActiveSheet.PageSetup.PrintArea = PrArea
         ' the cell in column 1 and in the row immediately below the pagebreak
         ' contains text for the footer
        ActiveSheet.PageSetup.CenterFooter = Cells(q, 1)
         '  ActiveSheet.PrintOut copies:=1
    Next i
    Dim i ' AQUI É QUE A COISA COMPLICA 
   
    i = 0
   
    Set R = ActiveSheet.UsedRange
   
    nLastRow = R.Rows.Count + R.Row - 2
    nFirstRow = R.Row
   
    For n = nFirstRow To nLastRow
        If Cells(n, "A").EntireRow.Hidden Then
       
        Else
            i = i + 1
        End If
       
    Next
   
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(n, "A")
    With ActiveSheet.PageSetup
        .Zoom = 70
       End With
    With ActiveSheet
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    End With
    ActiveSheet.Protect Password:="123"
 Application.ScreenUpdating = True
End Sub

Se houver duas vezes "Dim i", onde, para cada uma, o valor de "i" é diferente, a macro vai dar erro.

Fico no aguardo.

No caso i e uma variavel que pode ser troacada sem problema nenhum. Dim e o comando para inicio da declaração da variavel.
Altere por exemplo para:
Dim iX as integer, '"(pode ser outra variavel qq)"

e em todos os lugares que se referem à "i" altere para iX

Não entendi , como neste exemplo se entendi direito deveria ser "CADA QUADRO" de cada cor deveria ser quebrado como uma página a ser impressa , mas a pagina a ser impressa ficou uma que não tem nada escrito ; alguem pode me ajudar?

Boa tarde!!

Veja isso

Sub page() 
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(41, 1) 
    For x = 1 To 5 
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(41 + x * 50, 1) 
    Next 
End Sub 

onde colo isso?

Bom dia!!
Pode ser dentro de um modulo.
Alt + F11, depois Alt + I + M

Bom dia, estou com uma seguinte duvida, eu gero o relatório, porém não quebra a página, queria definir um tamanho correto de linhas para impressão de cada pagina e quebrar essa página e no inicio de cada página iniciar o cabeçalho que esta no começo do relatório, alguém pode me ajudar, muito urgente!!!