Boa tarde pessoal,

Aos poucos estou adaptando os códigos para o que preciso.

Eu extraio um arquivo do SAP e tenho que importar para minha base.
O código abaixo até os 40% é bem rápido.
Dos 60% adiante demora um pouco.

Tem como otimizar alguma coisa ?

Obrigado.

Private Sub BotãoImportar_Click()

If Me.ListBox2.Text = "" Then

    MsgBox "Selecione um arquivo!", vbCritical
    
Else

frmZFI022.Hide

Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Set FSO = CreateObject("Scripting.FileSystemObject")
FileName = fPath & sArquivo

    Application.StatusBar = "Atualizando dados... 20% Concluídos!"
    
    PlanilhaAtiva = ActiveSheet.Name
    Plan25.Select
    rLast1 = Range("L1048576").End(xlUp).Row
    Range("C2:S" & rLast1).Select
    Selection.ClearContents

    Workbooks.Open FileName
    OpenBook = ActiveWorkbook.Name
    
    Windows(OpenBook).Activate
    
    Cells.Select
    Selection.Copy
    Windows(ThisWorkbook.Name).Activate
    Plan30.Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Application.StatusBar = "Atualizando dados... 40% Concluídos!"

    Windows(OpenBook).Activate
    Application.CutCopyMode = False
    Workbooks(OpenBook).Close False
    Windows(ThisWorkbook.Name).Activate

    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Range("A:B,D:F,H:I,K:K,P:P,S:S,AA:AA,AC:AJ").Select
    Range("A1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:Q").Select
    Selection.AutoFilter
    Application.StatusBar = "Atualizando dados... 60% Concluídos!"
    Range("A1").Select
    ActiveSheet.Range("$A:$Q").AutoFilter Field:=1, Criteria1:= _
        "=Empresa", Operator:=xlOr, Criteria2:="="
    rLast = Range("J1048576").End(xlUp).Row
    Rows("40:" & rLast - 1).Select
    Selection.Delete Shift:=xlUp
    Application.StatusBar = "Atualizando dados... 80% Concluídos!"
    Range("A1").Select
    ActiveSheet.Range("$A:$Q").AutoFilter Field:=1
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range(Application.ActiveCell.Address), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("I:I").Select
    Selection.TextToColumns Destination:=Range(Application.ActiveCell.Address), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Range("J2").Select
    rLast2 = Range("J1048576").End(xlUp).Row
    Range("A2:Q" & rLast2).Select
    Selection.Copy
    Plan25.Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
    Plan30.Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets(PlanilhaAtiva).Select
    
Application.StatusBar = "Atualizando dados... 100% Concluídos!"

MsgBox "ZFI022 atualizadas com sucesso!", vbInformation

Application.StatusBar = False
Application.ScreenUpdating = False

Unload frmZFI022

End If
End Sub