Este fórum está sendo desativado

[Andrelk]

Bom dia!
Sou iniciante em VBA e por este motivo acabo usando o gravador de vba´s para desenvolvimento de planilhas e atualmente estou precisando de auxilio pois gravei uma vba que esta demorando em média de 5 a 6 minutos para executar. Já realizei algumas alterações no código mas não ajudou muito.
Poderiam me auxiliar por favor!
Esse é o código:
Sub Atualizar_cargas()
'
' Atualizar_cargas Macro
Dim Tempo As Double
Tempo = Now()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Sheets("Dados_Cargas").Select
ActiveSheet.Range("$a$1:$d$10000").AutoFilter Field:=1, Criteria1:="<>"
Columns("A:d").Select
Selection.Copy
Sheets("Cargas_Filtradas").Select
Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
Sheets("Dados_Cargas").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Cells(1, 1).Select
Sheets("Painel").Select

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox Now() - Tempo


End Sub

Desde já agradeço!

[osvaldomp]

Olá, @Andrelk .

Experimente:

Código: Selecionar todos

Sub Atualizar_cargasV2()
 Dim Tempo As Double, LR As Long
  Tempo = Now()
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  With Sheets("Dados_Cargas")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   LR = .Cells(Rows.Count, 1).End(3).Row
   .Range("A1:D" & LR).AutoFilter Field:=1, Criteria1:="<>"
   .Range("A1:D" & LR).Copy
   Sheets("Cargas_Filtradas").[A1].PasteSpecial xlValues
   .ShowAllData
  End With
  Application.Calculation = xlCalculationAutomatic
  MsgBox Now() - Tempo
End Sub

[Andrelk]

Olá, @Andrelk .

Experimente:

Código: Selecionar todos

Sub Atualizar_cargasV2()
 Dim Tempo As Double, LR As Long
  Tempo = Now()
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  With Sheets("Dados_Cargas")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   LR = .Cells(Rows.Count, 1).End(3).Row
   .Range("A1:D" & LR).AutoFilter Field:=1, Criteria1:="<>"
   .Range("A1:D" & LR).Copy
   Sheets("Cargas_Filtradas").[A1].PasteSpecial xlValues
   .ShowAllData
  End With
  Application.Calculation = xlCalculationAutomatic
  MsgBox Now() - Tempo
End Sub

Muito obrigado...funcionou perfeitamente..... reduziu de 6 minutos para 58 segundos...