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
Postado : 19/03/2015 9:46 am