Bom dia amigos,
Outra bronquinha TOP. Tenho uma planilha que está toda bagunçada e para ajustar os dados fiz o código abaixo onde vai lendo em uma planilha e escrevendo em outra. o problema é que temos 42 mil linhas e está demorando muito o processo. Acredito que não utilizei a melhor forma para ajuste destes dados. Será que tem como acelerar mais este processo?

Private Sub CommandButton1_Click()
Sheets("BASE").Select
Dim UltimaLinha, i, z As Integer
UltimaLinha = Sheets("BASE").Cells(Cells.Rows.Count, 19).End(xlUp).Row
Sheets("BASE").Range("I1").Select
z = 2
For i = 1 To UltimaLinha * 5
    If Sheets("BASE").Range("I" & i).Value = "D" Then
        Sheets("TRAT").Range("A" & z).Value = Sheets("BASE").Range("B" & i).Value 'Origem
        Sheets("TRAT").Range("B" & z).Value = Sheets("BASE").Range("I" & i).Value 'C/D
        Sheets("TRAT").Range("D" & z).Value = Day(Sheets("BASE").Range("K" & i).Value) 'Data de Lançamento
        Sheets("TRAT").Range("E" & z).Value = Month(Sheets("BASE").Range("K" & i).Value) 'Data de Lançamento
        Sheets("TRAT").Range("F" & z).Value = Year(Sheets("BASE").Range("K" & i).Value) 'Data de Lançamento
        Sheets("TRAT").Range("C" & z).Value = Sheets("TRAT").Range("D" & z).Value & "/" & Sheets("TRAT").Range("E" & z).Value & "/" & Sheets("TRAT").Range("F" & z).Value
        Sheets("TRAT").Range("G" & z).Value = Sheets("BASE").Range("P" & i + 1).Value 'Favorecido
        Sheets("TRAT").Range("H" & z).Value = Sheets("BASE").Range("Q" & i + 1).Value 'Histórico
        Sheets("TRAT").Range("I" & z).Value = Sheets("BASE").Range("Q" & i + 3).Value 'Plano de Conta
        Sheets("TRAT").Range("J" & z).Value = Sheets("BASE").Range("O" & i + 3).Value 'Centro de Custo
        Sheets("TRAT").Range("K" & z).Value = Sheets("BASE").Range("T" & i).Value * -1 'Valor
        z = z + 1
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Next i
MsgBox "Processo Concluido com sucesso!"
Sheets("Trat").Select
Unload Me
End Sub