Tentei uma gambiarra aqui, mas não to conseguindo selecionar o conjunto de linhas que preciso ; dá - Erro em tempo de execução '1004: Erro de definição de aplicativo ou definição de objeto.

Sub copiaCola()
Dim pl As Long
Dim ul As Long
Dim rng As Range
sht = ActiveSheet.Name
Set rng = Sheets(sht).Range("A2:Bh30")
rng.Select
Application.CutCopyMode = False
Selection.Copy
y = Range("A65536").End(xlUp).Row ' Ultima linha preenchida antes da "COLAGEM"

ul = Sheets(sht).Range("A65536").End(xlUp).Row
Sheets(sht).Range("A2:Bh30").Offset(ul - 1).Select ' determina para colar na primeira linha vazia
ActiveSheet.Paste

w = Range("A65536").End(xlUp).Row ' Ultima linha preenchida após a "COLAGEM"

Set rng = Sheets(sht).Range("A2:Bh30") ' Copia novamente
rng.Select
Application.CutCopyMode = False
Selection.Copy

Rows("y:w").Select           ' Seleciona o ultimo conjunto de linhas COPIADA/COLADA e cola especial os formatos
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

End Sub

'fiz o teste sem ser via código , funciona , mas tenho que selecionar a linha completa do inicio ao fim
'porem não estou conseguindo selecionar as linhas com o Rows("y:w").Select , qual a maneira correta?

tentei entirerow , tambem não deu

Boa noite!!

Eu ainda não compreendi o que quer...

Poste seu arquivo e explique mais

Att

Veja se é isto, faça as modificações abaixo e teste:

Altere as Linhas :

y = Range("A65536").End(xlUp).Row + 1

w = Range("B65536").End(xlUp).Row + 1

e a linha:
Rows("y:w").Select
Para :
Rows(y & ":" & w).Select

[]s

Mauro esse
Rows(y & ":" & w).Select resolveu a questão da seleção da linha toda .
mas não consegui o meu objetivo
dá uma olhada na plan por favor

Alexandre , ta ai o exemplo ,é so ver que a altura das linhas coladas não são da mesma altura da copiada

Não entendi exatamente o objetivo,
mas veja se ajuda?

Sub copiaCola()
Dim Y As Long
Dim W As Long
Dim rng As Range
sht = ActiveSheet.Name
Set rng = Sheets(sht).Range("A2:Bh30")
rng.Select
Selection.Copy
Y = Range("A65536").End(xlUp).Row + 1 ' Ultima linha preenchida antes da "COLAGEM"
Sheets(sht).Range("A" & Y).Select
ActiveSheet.Paste
Application.CutCopyMode = False
    
W = Sheets(sht).Range("A65536").End(xlUp).Row
Range("A" & W - 28).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ActiveSheet.PageSetup.PrintArea = "$A$32:$M$" & pl '+ 1

rng.Select
Selection.Copy
Rows(Y & ":" & W).Select           ' Seleciona o ultimo conjunto de linhas COPIADA/COLADA e cola especial os formatos
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

End Sub

Cara, se entendi bem, você quer além de copiar os conteúdos e formatos de texto das células, também manter a altura das linhas, certo?

Se for isso, tente usar:

---Para colar as informações---
<...>.PasteSpecial Paste:= xlValuesAndNumberFormats

---Para a altura das linhas---

Public Sub Colar()

'Declara variável para guardar altura da linha
dim alturaLinha as double

'faz os procedimentos todos e tal....

'ANTES DE COPIAR AS LINHAS, SELECIONE ALGUMA DESSAS QUE ESTEJA COM A ALTURA QUE VC QUER
alturaLinha = Cells(X,Y).RowHeight

'COPIE E COLE SEUS DADOS...
'...
'...
'...

'SELECIONE O RANGE ONDE OS DADOS FORAM COLADOS E FAÇA
Selection.RowHeight  = alturaLinha

End Sub

Veja se é isso e avise.

Abraços.

OBS: Não testei o código, fui escrevendo de cabeça.

Vou testar aqui ; para ver qual ira satisfazer o que preciso.

Que é:

Copiar A2:BH30 e colar de maneira que a colagem fique com as mesmas alturas de linha da area copiada , por exemplo :
altura da linha 1 copiada =53 altura da linha 1 colada =53
altura da linha 2 copiada =33 altura da linha 2 colada =33
altura da linha de 3 a 20 copiada =43,5 altura da linha 3 a 20 colada =43,5

Boa noite!!

Tente...

Sub AleVBA_Gambiarra()

    Rows("1:1").RowHeight = 53
     Rows("2:2").RowHeight = 33
      Rows("3:20").RowHeight = 43.5

End Sub

Ok alexandre mas a "copiada" eu sei que é linha 1 Rows("1:1") ; a "colada" não sei qual vai ser ; então o que precisava era uma maneira de copiar e colar mantendo os formatos

Boa noite!!

Claudinei, faça os testes!!

Sub Teste_AleVBA()
    Dim pl As Long
    ActiveSheet.Range("A2:BH30").Copy Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    pl = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("A" & pl - 28).Select
    Range("A31:BH" & pl).RowHeight = Range("A2:BH30").RowHeight
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    ActiveSheet.PageSetup.PrintArea = "$A$32:$M$" & pl
    ActiveSheet.Range("D100").Offset(ul - 95).Select
End Sub

Vou testar aqui ; para ver qual ira satisfazer o que preciso.

Que é:

Copiar A2:BH30 e colar de maneira que a colagem fique com as mesmas alturas de linha da area copiada , por exemplo :
altura da linha 1 copiada =53 altura da linha 1 colada =53
altura da linha 2 copiada =33 altura da linha 2 colada =33
altura da linha de 3 a 20 copiada =43,5 altura da linha 3 a 20 colada =43,5

Se é isso, não é difícil cara. É só adaptar meu código.

Na declaração da variável alturaLinha, mude ela pra um array do tipo double:

Dim alturaLinha() as Double

Depois, quando for copiar as informações, faça um loop nas linhas do seu range:

Public Sub CopiaColaAlturaLinha()

Dim alturaLinha() as Double
Dim i                   as Integer
Dim myRng          as Range

'DEFINE O RANGE DAS INFORMAÇÕES
set myRng = range("sua área a ser copiada")

'REDIMENSIONA O ARRAY COM O NÚMERO DE LINHAS
redim alturalinha(myRng.rows.count - 1) as double

'COLOCA AS ALTURAS DE LINHAS NAS POSIÇÕES DO ARRAY
For i = 0 to (myRng.Rows.Count - 1) step 1
    alturaLinha(i) = myRng.Rows(i+1).RowHeight
Next i

'COLOQUE O CÓDIGO DE COLAGEM AQUI

'DEFINA O myRng COMO A NOVA ÁREA ONDE OS DADOS FORAM COLADOS
set myRng = Range("PRIMEIRA CÉLULA DA ÁREA COLADA").CurrentRegion

'MUDA AS ALTURAS DAS LINHAS COLADAS PARA AS QUE ESTÃO NO ARRAY
For i = 0 to (myRng.Rows.Count - 1) step 1
    myRng.Rows(i+1).RowHeight = alturaLinha(i)
Next i

End Sub

Pronto. Não testei mas acredito que funcione. Avise.

Abraços.

Kdu , não consegui adaptar;
O código que estou usando é este:

Option Private Module
Sub copiaCola()
Desprot
Dim pl As Long
Dim ul As Long
Dim rng As Range
sht = ActiveSheet.Name
Set rng = Sheets(sht).Range("A2:Bh30")
rng.Select
Selection.Copy
y = Range("A65536").End(xlUp).Row ' Ultima linha preenchida antes da "COLAGEM"
ul = Sheets(sht).Range("A65536").End(xlUp).Row
Sheets(sht).Range("A2:Bh30").Offset(ul - 1).Select
ActiveSheet.Paste
    
pl = Sheets(sht).Range("A65536").End(xlUp).Row
Range("A" & pl - 28).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ActiveSheet.PageSetup.PrintArea = "$A$32:$M$" & pl '+ 1

Sheets(sht).Range("D100").Offset(ul - 95).Select
Prot
End Sub

seria possivel me ajudar na adaptação?
As alturas das linhas são :
1° linha - 60
2°linha - 33,75
3° linha - 28,5
4° linha a 27° - 43,5
28° linha - 58,5
29° linha - 63,00

Bom dia!!

Claudinei, tentou minha sugestão?????????????????????