ptk, se ao se referir em Celulas em Branco como todas as celulas na Linha, pode-se utilizar o AutoFiltro e ocultar as celulas em branco, e depois utilizar a rotina abaixo para setar a área de impressão só coma as visiveis:

    Sub AjustarPrintArea()
        Dim i
       
        i = 0
       
        Set r = ActiveSheet.UsedRange
       
        nLastRow = r.Rows.Count + r.Row - 1
        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")

    End Sub

[]s

Não consegui usar por alguns motivos "eu acho"

Antes de imprimir eu executo uma macro de classificar o resultado que quero puxando de uma base de dados
e também tenho informações nessa "mascara de protocolo"

Não sei dizer porque não funcionou ao certo, mas não funcionou rs

segue a planilha para melhor identificar o problema

Acho que assim fica melhor =)

ptk, como o arquivo é um pouco grande e as alterações serão poucas, vou passar somente o que deve alterar :

Na Aba "Protocolo Geral", na Coluna "B", de B2 até B4500, altere todas as formulas conforme abaixo :
De :
=SE(F11=0;0;SE(OU(C11<>0;J11<>0);B10+1;0))
Para
=SE(F11=0;"";SE(OU(C11<>0;J11<>0);B10+1;0))

Ou seja, Somente Troque o "ZERO" pelas ASPAS, faça esta troca sómente nas formulas da coluna citada, até a B4500.

Depois execute a rotina abaixo, e veja se é o resultado esperado.

Sub AjustarPrintArea2()
    
    Dim lastRow As Long
    Dim cell As Object, lngLastRow As Long
    
    'Armazena a Ultima celula
    lastRow = Range("B" & Rows.Count).End(xlUp).Row
        
        For Each cell In ActiveSheet.Range("B2" & ":" & "B" & lastRow)
            ' Conta as Celulas diferentes de Nulas (empty) desconsiderando as formulas
            If Not IsNull(cell.Value) And Len(Trim(cell.Value)) > 0 Then _
                lngLastRow = cell.Row
        Next cell
        
    'Redefine Area e Impressão
    With ActiveSheet.PageSetup
        .PrintArea = "$B$2:$J$" & lngLastRow
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    ActiveSheet.PrintPreview

End Sub

[]s

Mais que perfeito =)

Muito obrigado mais uma vez.

Tu devia ter um site de curso de VBA =D
Sou aluno em potencial rs

Mauro,

Vi a solução dada para o problema, testei e funcionou perfeitamente. Se na área de impressão eu precisar variar tanto a quantidade de linhas (como foi o exemplo) como também a quantidade de colunas. Como ficaria a instrução?

Obrigado

Albraz