Olá Pessoal segue um código que desenvolvi para um amigo meu para ajudá-lo nas otimizações dele, espero que ajude-os,
Abraços a todos!
Sub Macro2()
Plan6.Activate
Application.Calculation = xlCalculationManual
If Plan6.FilterMode Then Plan6.ShowAllData
U_L = Plan6.Range("A" & Rows.Count).End(xlUp).Row
U_L2 = Plan4.Range("A" & Rows.Count).End(xlUp).Row + 1
Plan6.Range("A1:L" & U_L).AutoFilter Field:=1, Criteria1:="CONTADO"
Plan6.Range("B2:D" & U_L).Copy
Plan4.Range("A" & U_L2).PasteSpecial Paste:=xlPasteValues
Plan6.Range("E2:F" & U_L).Copy
Plan4.Range("E" & U_L2).PasteSpecial Paste:=xlPasteValues
If Plan6.FilterMode Then Plan6.ShowAllData
For i = U_L To 2 Step -1
If Plan6.Range("A" & i) = "CONTADO" Then
Plan6.Rows(i).Clear
End If
Next
Plan6.Sort.SortFields.Clear
Plan6.Sort.SortFields.Add Key:=Range("B2:B" & U_L), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Plan6.Sort
.SetRange Range("A1:M" & U_L)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Calculation = xlCalculationAutomatic
End Sub
Baldini Fabio