Oi gtsalikis.

Se vc bloquear a exibição da tela com a instrução 'Application.ScreenUpdating' ganhará alguns segundos. Veja se isto ajuda.

Ficaria assim o código de teu botão:

Sub Cassiano()
On Error GoTo Erro

    Dim Verifica As Integer
        Verifica = MsgBox("Você lembrou de selecionar acima quais prioridades vão para o Cassiano?", vbYesNo, "Atenção")
            If Verifica = vbYes Then
                
            Else: Exit Sub
            End If
''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = False
''''''''''''''''''''''''''''''''''
    Sheets("Controle Prazos").Select
    Range("A3:A1048576").Select
    Selection.Copy
    Sheets("Cassiano").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Controle Prazos").Select
    Range("B3:B1048576").Select
    Selection.Copy
    Sheets("Cassiano").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Controle Prazos").Select
    Range("F3:F1048576").Select
    Selection.Copy
    Sheets("Cassiano").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Controle Prazos").Select
    Range("C3:C1048576").Select ' alterei aqui, coluna I por coluna C
    Selection.Copy
    Sheets("Cassiano").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Controle Prazos").Select
    Range("AB3:AB1048576").Select
    Selection.Copy
    Sheets("Cassiano").Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Controle Prazos").Select
    Range("AC3:AC1048576").Select
    Selection.Copy
    Sheets("Cassiano").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''
        
    Dim Limpar As Integer, Export As Integer
        
        Limpar = MsgBox("Deseja deixar somente os dados que serão enviados para o Cassiano?", vbYesNo, "Limpar")
            If Limpar = vbYes Then
                Call Filtrar
            Else: Exit Sub
            End If
        
        Export = MsgBox("Deseja criar uma nova planilha para enviar para o Cassiano?", vbYesNo, "Exportar")
            If Export = vbYes Then
                Call Exportar
                Call Sair
            Else: Sheets("Controle Prazos").Select
                Range("BD18:BE19").Select
            End If

Exit Sub
Erro:
''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''
End Sub

Qualquer coisa dá um grito.

A propósito:

Como tua rotina chama outra rotinas, então use no inicio de cada rotina lenta o código abaixo:

Application.ScreenUpdating = False

e o código abaixo no final da rotinas.

Application.ScreenUpdating = True

Lembre-se que o 'False' bloqueia a tela pra não ficar atualizando e perdendo tempo e o 'True' habilita novamente: Ou seja, em qualquer ponto em que há a possibilidade da rotina ser encerrada deve-se usar o 'Application.ScreenUpdating =true'.

A propósito:

Como tua rotina chama outra rotinas, então use no inicio de cada rotina lenta o código abaixo:

Application.ScreenUpdating = False

e o código abaixo no final da rotinas.

Application.ScreenUpdating = True

Lembre-se que o 'False' bloqueia a tela pra não ficar atualizando e perdendo tempo e o 'True' habilita novamente: Ou seja, em qualquer ponto em que há a possibilidade da rotina ser encerrada deve-se usar o 'Application.ScreenUpdating =true'.

AdolfoLima,

Obrigado pela dica. Ela melhorou a apresentação, mas o meu problema de esperar uma eternidade só para fazer uma cópia da planilha permanece.

gtsalikis, não tenho como ver o seu modelo no momento, e nas dicas do Adolfo, a instrução "Application.ScreenUpdating" até chega a dar uma melhora, mas analisando pelo código postado, percebe-se que uma das causas da perda de performance são as instruções repetitivas e algumas desnnecessárias, que geralmente são adicionadas quando da utilização do recurso "Gravador de Macro" que capta todas as ações e muitas das instruções podem ser suprimidas ou ajustadas.

Então nesta rotina postada acima, temos :

Para utilizarmos o Copy e o Paste :
6 vezes a instrução : Sheets("Controle Prazos").Select, mais
6 vezes Range("xxx:xxxxxxx").Select, mais
6 vezes : Sheets("Cassiano").Select, mais
6 vezes : Range("xx").Select

Ou seja, não necessitamos utilizar instruções "SELECT".

Nestas linhas :
Sheets("Controle Prazos").Select
Range("A3:A1048576").Select
Selection.Copy

Sheets("Cassiano").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Utilizamos a Instrução With indicando somente uma vez a aba que que queremos trabalhar :

Ficando da seguinte maneira :

With Sheets("Controle Prazos")
    .Range("A3:A1048576").Copy
        Sheets("Cassiano").Range("A3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    .Range("B3:B1048576").Copy
        Sheets("Cassiano").Range("B3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    .Range("F3:F1048576").Copy
        Sheets("Cassiano").Range("C3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    .Range("C3:C1048576").Copy
        Sheets("Cassiano").Range("D3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    .Range("AB3:AB1048576").Copy
        Sheets("Cassiano").Range("E3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    .Range("AC3:AC1048576").Copy
        Sheets("Cassiano").Range("F3").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Application.CutCopyMode = False
        
End With

Lembrando, que se não tivermos formulas nas celulas ainda podemos utilizar "Copy Destination".

Espero que tenha conseguido me fazer entendido, 6ª f é brabo, e tive de parar varias vezes, só agora consegui enviar, mais tarde se der, la em casa baixo seu exemplo e dou uma analisada melhor, que até nas linhas que postei acima ainda dá para dar mais uma enxugada.

[]s

Muito obrigado, Mauro,

Com a tua ajuda e a do AdolfoLima, simplifiquei o código em uma unica sub e ainda ganhei um tempo extra com essa dica de bloquear a exibição dos procedimentos.

Abaixo segue o código (que foi refeito quase na totalidade):

Sub Exportar()


'Etapa 1 - definir quais informações serão copiadas segundo as prioridades escolhidas
': Etapa_1
    
    Dim Verifica As Integer
        Verifica = MsgBox("Você lembrou de selecionar acima quais prioridades vão para o Cassiano?", vbYesNo, "Atenção")
            'If_1
            If Verifica = vbYes Then
            
            
'Etapa 2 - copiar as informações para a planilha Cassiano
     
' -- ----- ----- ----- ----- -----
Application.ScreenUpdating = False
' -- ----- ----- ----- ----- -----

        Sheets("Cassiano").Select

            Range("A3:F1048576").Select
                Selection.ClearContents

    Dim Prioridade_Inicial As Integer, Prioridade_Final As Integer
            
        Sheets("Controle Prazos").Select
            
            Prioridade_Inicial = Abs(Range("BE15")) - 1
            Prioridade_Final = Abs(Range("BE16")) + 1
            
                FinalRow = Range("A1000").End(xlUp).Row
                i = 3
            
                    Do While i <= FinalRow
                
                    Sheets("Controle Prazos").Select
                        
                        If Abs(Cells(i, 3)) > Prioridade_Inicial And Abs(Cells(i, 3)) < Prioridade_Final And Cells(i, 3) <> "" Then

                            With Sheets("Controle Prazos")
                                .Cells(i, 1).Copy
                                    Sheets("Cassiano").Cells(i, 1).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                .Cells(i, 2).Copy
                                    Sheets("Cassiano").Cells(i, 2).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                .Cells(i, 3).Copy
                                    Sheets("Cassiano").Cells(i, 3).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                .Cells(i, 6).Copy
                                    Sheets("Cassiano").Cells(i, 4).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                .Cells(i, 28).Copy
                                    Sheets("Cassiano").Cells(i, 5).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                .Cells(i, 29).Copy
                                    Sheets("Cassiano").Cells(i, 6).PasteSpecial _
                                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                                Application.CutCopyMode = False
        
                            End With
                            
                            FinalRow = FinalRow - 1
                            
                            i = i + 1
                        
                        Else
                        
                            i = i + 1
                            
                        End If
            
                    Loop
            
            
        Sheets("Cassiano").Select
            
            Range("A3:F1000").Select
            ActiveWorkbook.Worksheets("Cassiano").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Cassiano").Sort.SortFields.Add Key:=Range("C3:C58" _
                ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Cassiano").Sort
                .SetRange Range("A3:F1000")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            
            
' - ----- ----- ----- ----- -----
Application.ScreenUpdating = True
' - ----- ----- ----- ----- -----

'Etapa 3 - Verificar se vai ser gerada a nova planilha para enviar ao Cassiano
        
    Dim Export As Integer
    
        Export = MsgBox("Deseja criar uma nova planilha para enviar para o Cassiano?", vbYesNo, "Exportar")
            If Export = vbYes Then
                
' -- ----- ----- ----- ----- -----
Application.ScreenUpdating = False
' -- ----- ----- ----- ----- -----

                Sheets("Cassiano").Select
                    Sheets("Cassiano").Copy
                
                Windows("Controle prazos_GT_V2.xlsm").Activate
                    ActiveWorkbook.Save
                    ActiveWorkbook.Close
                                
' - ----- ----- ----- ----- -----
Application.ScreenUpdating = True
' - ----- ----- ----- ----- -----
                                
            Else: Sheets("Controle Prazos").Select
                Range("BD18:BE19").Select
            End If


            'Continuação do If_1
            Else: Exit Sub
            End If

End Sub

gtsalikis, apesar de ter colocado como resolvido, é bom ver que tem se esforçado, então vai mais algumas obs, procure utilizar com cautela os congelamentos de tela, na maioria das vezes a instrução :

Application.ScreenUpdating = False

É adicionada no Inicio da Rotina, e depois revertemos para True somente no Final, não há necessidade de se colocar antes de cada execução, uma vez que iniciou como "FALSE", ela só será "TRUE", no momento em que a revertermos.

Você deu uma ajustada na Rotina, mas ainda está cometendo os mesmos equivocos que citei anteriormente, quando utiliza o "Select":
Quando utilizamos :

With Sheets("Controle Prazos")
Significa que toda a ação executada neste espaço, se refere a Sheets("Controle Prazos")

End With

Sendo assim não precisaria utilizar a instrução:
Sheets("Controle Prazos").Select - 5 linhas acima.

e nas linhas :
Sheets("Cassiano").Select
Range("A3:F1048576").Select
Selection.ClearContents

eliminamos os "Select" e ajustamos para :
Sheets("Cassiano").Range("A3:F1048576").ClearContents

De qualquer forma, como eu disse acima, parabens pelo esforço em aprender.

[]s

Mauro,

O congelamento de tela eu desativei sempre que chamo uma MsgBox. (Não sei se é necessário, embora eu pudesse testar rapidamente). Mas o motivo também é porque a planilha vai ser usada por outras pessoas, que podem se perguntar o que está acontecendo, ou coisas do tipo, então fiz meio que de propósito pensando nessas coisas.

A mesma coisa com as seleções de planilhas que eu coloquei a mais. (Embora eu saiba pouco de VBA, está ficando recorrente ter que dar uma mexida nos códigos que eu faço, par ajustar algo porque me pedem*, então, já estou tentando fazer blocos que eu possa copiar/colar e ramanejar facilmente, ou que evitem que eu me perca no código.

* não que seja ruim, pq assim aprendo mais, só que as vezes a mudança é pra ontem, ai complica.

Mas, muito obrigado pelas dicas. Eu pesquiso possibilidades e trabalho a partir de exemplo (acho que todos fazem isso), mas quando não funciona é difícil descobrir porque não funciona. Então essas dicas ajudam pacas.