Olá Fabiosp.

Tenta substituir a tua rotina 'Colar' por estas abaixo:
(Antes de colar a rotina abaixo, faça uma cópia de segurança de tua planilha)

Sub colar()
' colar Macro
    
    Sheets("dados").Select
    Range("M17:Q42").Select
    Selection.Copy
    Sheets("relatorio").Select
    Range("B27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
       
        If Sheets("relatorio").Range("C27").Value = "" Then
        
            Sheets("relatorio").Range("B27:F27").Value = "-"
            
        End If

'************** Alteração na tua rotina ***************
    ' Desfaz formatação anterior
Desquadricular
    ' formata de acordo com a quantidade de células preenchidas (Chame 'Quadricular2 se só deseja bordas externas)
Quadricular

'***********Fim da alteração na tua rotina ******************

MsgBox "Depois d concluir este procedimento 'Printar' o Relatorio."
End Sub

Sub Quadricular() ' Preenche todas as bordas
On Error Resume Next
Dim i As Integer

For i = 27 To 53
    If Plan3.Cells(i, 2) = "" Then GoTo Formatar
Next i

Exit Sub
Formatar:

i = i - 1

Range("B27:F" & i).Select    ' Seleciona linhas preenchidas
        ' Formata as bordas
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
Range("A1").Select

End Sub

Sub Quadricular2() ' Preenche só as bordas externas
On Error Resume Next
Dim i As Integer

For i = 27 To 53
    If Plan3.Cells(i, 2) = "" Then GoTo Formatar
Next i

Exit Sub
Formatar:

i = i - 1

Range("B27:F" & i).Select    ' Seleciona linhas preenchidas
        ' Formata as bordas
    Range("B27:F42").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
Range("A1").Select

End Sub

Sub Desquadricular()
    
    Range("B27:F53").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B26:F26").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.SmallScroll Down:=-27
    Range("A26").Select
End Sub

Foi feito com 'Gravar macro'. Só adaptei uma rotina 'FOR' para localizar a última linha preenchida.

Se não for bem isto que vc quer, dá um toque.

Boa tarde!!

Outra forma

Sub InserirBordas()
  
  Dim ws As Worksheet
  Dim lLineStyle As XlLineStyle
  Dim lWeight As XlBorderWeight
  
  lLineStyle = xlContinuous
  lWeight = xlMedium 'para usar uma borda fina use: xlthin
  
  Set ws = ActiveSheet

  With ws.Range("A1:E10")
    .BorderAround LineStyle:=lLineStyle, Weight:=lWeight
    With .Borders(xlInsideVertical)
      .LineStyle = lLineStyle
      .Weight = lWeight
    End With
    With .Borders(xlInsideHorizontal)
      .LineStyle = lLineStyle
      .Weight = lWeight
    End With
  End With
End Sub

A título de curiosidade, Fabiosp, também é possível o 'PrintScreen' por VBA.

Se quiser utilizar, segue o código:

Sub CapturarTela()
Application.SendKeys "(%{1068})"    ' Aciona tecla 'PrintScreen'
DoEvents                            ' Executa evento
End Sub

Aí, é só colocar no final de tua rotina.

Boa noite senhores.
Muito obrigado pela ajuda.
Testei o macro criado pelo Alexandre e Pelo Adolfo,porém não funcionou com necessito.
Não sei se foi possivél verificar minha tabela,mas o que necessito e que na plan relatorio seja colocado borda apenas aonde tem informação.
O problema e que a quantidade de informação são variaveis as vezes tem 10 linhas ou 15 etc..
O que ficou mais próximo do que necessito foi a macro do Alexandre porèm ela inseri bordas da cèlula B27:F52 e necessito que apenas aonde tem informação seja incluído bordas.
depois na próxima busca que seja apagado e depois seja inserido novamente apenas nas celulas com informação.

Desde já agradeço a ajuda de todoas
Espero que possam me ajudar.

Abraços.

Olá Fabiosp.

No código q te enviei havia três rotinas:
Sub Colar() (que é a tua com uma pequena modificação)
Sub Desquadricular() (Retira todas as bordas antes de inserir novas)
Sub Quadricular() (Vê até que linha há valor e preenche as bordas nelas)

Elas trabalham juntas e vc precisa copiar todas pra tua planilha. Confere se vc fez assim. No meu teste funcionou legal.

Boa noite AdolfoLima

Agradeço a sua colaboração.
Sou novato no assunto acho que por isso não consegui.
Desculpe!!Mas vericando sua mensagem em pratica e isso mesmo que necessito.

Colar informação >>Desquadricular(Retira todas as bordas antes de inserir novas)>>>Quadricular (Vê até que linha há valor e preenche as bordas nelas)

Vou testar novamente para ver se na fiz algo errado depois te aviso.
Desculpe a pergunta, mais você testou na minha planhilha ?

Desde já agradeço sua estimada gentileza e desculpa por tomar seu tempo caro colega.

Abraços

Bom dia AdolfoLima,
Tudo bem?

Acho que já eu entendi qual era o problema.
As 3 rotinas que você criou foram feitas para rodar separadamente tipo roda macro pra colar depois roda macro pra desquadricular e depois roda o macro pra quadricular, não é isso?
Sem querem abusar da sua boa vontade, mas não teria uma forma de juntar tudo isso?
Eu até tentei mas da erro tipo 438 depois quando eu aperto em depurar fica amarelo o campo .TintAndShade = 0
Esse erro acontece apenas no desquadricular.
Que será que eu fiz de errado?

Desculpe o incomodo e espero que você possa ajudar.

Abraços.

Bom dia AdolfoLima,
Tudo bem?

Acho que já eu entendi qual era o problema.
As 3 rotinas que você criou foram feitas para rodar separadamente tipo roda macro pra colar depois roda macro pra desquadricular e depois roda o macro pra quadricular, não é isso?

É isto.

Sem querem abusar da sua boa vontade, mas não teria uma forma de juntar tudo isso?

Tem, mas é menos didático e deixando separado vc pode facilmente chamá-lo a partir de qualquer outra rotina

Eu até tentei mas da erro tipo 438, depois quando eu aperto em depurar fica amarelo o campo .TintAndShade = 0
Esse erro acontece apenas no desquadricular.
Que será que eu fiz de errado?

O Erro 438 indica "O objeto não suporta a propriedade ou método - Isto pode ser provocado por eu e voce estarmos usando versões diferente do Excel. Eu estou usando o Oficce 2013.
Para resolver, sugiro que coloque como 'comentário' as linhas que apresentarem erro. Tipo assim:

' .TintAndShade = 0

(ou seja, simplesmente colocando um apóstrofe (') antes da linha que ficou amarela.)

Desculpe o incomodo e espero que você possa ajudar.

Abraços.

A propósito, Fabiosp, como já havia dito, a rotina 'Desquadricular' foi feita simplesmente em 'Gravar macro'. Vc pode fazer o mesmo e substituir todo o conteúdo da minha rotina 'Desquadricular'.

Esquenta não. Todos nós estamos aprendendo e pra todos que estão no fórum, ajudar é um prazer.

Boa tarde AdolfoLima

Muito obrigado pela atenção e paciência.

Agora que você esclareceu minhas dúvidas creio que vou conseguir resolver esse problema.
Vou tentar novamente e depois lhe aviso.

Eu achei essa idéia de deixar as rotinas separadas legal realmente é mais didático,
mas e que eu uso esta tabela com meu chefe e sabe como é chefe...
Ele quer que tudo se resolva em um click mas não faz nada pra que isso aconteça.
Vou tentar juntar novamente se não conseguir paciência.

Eu gostei da última frase que você postou.
Merecia receber uns 100 joinha.rs
Pena que só é possível receber um.

Abraços

Bom dia AdolfoLima,
Tudo bem?

Muito obrigado pela ajuda!!
Consegui resolver este problema parcialmente graças a sua ajuda.
Eu consegui colar a macro em uma planilha e funcionou perfeitamente
depois fui tentar colar em outra planilha com mesmo formato apenas com informações diferentes, porém quadricula apenas a primeira linha(B27:F27).
Seria a formatação das celulas da planilha?

Desculpa lhe incomodar com várias perguntas, mas acho que referente a esta questão será a última.

Abraços.

Olha Fabiosp.

A rotina 'Quadricular' formata todas as linhas em que a coluna 'B' esteja preenchida. (entre as linhas 27 e 53 - Se quiser outra área precisa mudar os valores que estão na cor verde)
O que define a coluna 'B' como referencia de última linha preenchida é o número em vermelho, conforme recorte colado abaixo:

'==========================================
...
Sub Quadricular() ' Preenche todas as bordas
On Error Resume Next
Dim i As Integer

For i = 27 To 53
If Plan3.Cells(i, 2) = "" Then GoTo Formatar
Next i

Exit Sub
Formatar:
...
'===========================================

Note o número 2 refere-se a coluna 'B'. Se quiser formatar a linha em que a coluna 'C' esteja preenchida é só mudar o valor para '3' e assim sucessivamente.
Veja se estas referências batem com a tua nova planilha.

Boa noite AdolfoLima,

Era isso mesmo !
Agora esta tudo certo!!
Na verdade eu não sabia o significado de "For i ="
mas agora com sua explicação detalhada esta esclarecido.

Agradeço a sua ajuda e paciência com aos leigos caro colega.

Até a próxima.rs

Abraço

Boa noite!!

Olá, Fabiosp, para manter o fórum organizado, lembre se de marcar seu post como resolvido!!

Veja como em:
viewtopic.php?f=7&t=3784

Att

Boa noite AdolfoLima,
...
Até a próxima.rs

Abraço

Que bom que deu certo, Fabiosp.
Dá uma pesquisada sobre instruções de repetição, como FOR e WHILE. São ferramentas poderosas e muita coisa se resolve com elas.