Macro très très lente sur 200000 lignes

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim Départ As Double, arrivée As Double, Durée As Double
    Dim mn As Long, ms As Long, sd As Long
    Dim i As Long, DernLign As Long
    Dim temps As String
    Dim compteur As Long
    Dim progression  As Long
    
    ProgressBar.Width = 0
    ProgressBar.Visible = False
    compteur = 0
    progression = 0
    CommandButton1.Visible = False
    Lbl_Wait.Visible = True
    Lbl_Maj.Visible = True
    ProgressBar.Visible = True
    Lbl_time.Visible = True
    
    Départ = GetTickCount&
    DernLign = Feuil4.Range("A" & Rows.Count).End(xlUp).Row
    Range("J3:J" & DernLign).FormulaR1C1 = "=IFERROR(IF(OR(RC[-4]=""Pas de Fax"",RC[-4]=0),0,VLOOKUP(C[-9],Retour!C[-9]:C[-1],9,FALSE)),""MAJ EN ATTENTE"")"
    Range("J3:J" & DernLign).Value = Range("J3:J" & DernLign).Value

    For i = 3 To DernLign
        compteur = compteur + 1
        With ActiveSheet
            If Range("J" & i).Value = "MAJ EN ATTENTE" Then
                Range("J" & i).FormulaR1C1 = "=IFERROR(IF(OR(RC[-4]=""Pas de Fax"",RC[-4]=0),0,VLOOKUP(C[-9],Retour!C[-9]:C[-1],9,FALSE)),""MAJ EN ATTENTE"")"
            Else
                progression = progression + 1
                ProgressBar.Width = progression * 1.5
                ProgressBar.Caption = progression & " %"
                arrivée = GetTickCount&
                Durée = arrivée - Départ
                mn = Int(Durée / 1000 / 60)
                sd = Int((Durée / 1000) - (mn * 60))
                ms = Durée - (sd * 1000) - (mn * 1000 * 60)
                temps = mn & ":" & sd & ":" & ms
                Lbl_time.Caption = temps
                DoEvents
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True:
    UsfWait.Height = 185.25
    ProgressBar.Caption = "Traitement terminé"
    CommandButton1.Visible = False
    Lbl_Wait.Visible = False
    CommandButton2.Visible = True
    Lbl_Maj.Visible = False
    Img_goodJob.Visible = True
End Sub

Sub ccm_mm()
Dim Derlig As Long, T_cola, T_coli, D_retour As Object
 Dim Cptr As Long, Ref As String
 Dim T_colf, T_colj
 
 Dim Start As Single
 
    Start = Timer
    Application.ScreenUpdating = False
    
    With Sheets("Retour")
        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
        T_cola = .Range("A2:A" & Derlig)
        T_coli = .Range("I2:I" & Derlig)
        Set D_retour = CreateObject("scripting.dictionary")
        
        For Cptr = 1 To UBound(T_cola)
            Ref = T_cola(Cptr, 1)
            If Not D_retour.exists(Ref) Then: D_retour.Add Ref, T_coli(Cptr, 1)
        Next
        Set T_cola = Nothing
        Set T_coli = Nothing
    End With
    
    With Sheets("Saisie")
        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
        T_colf = .Range("E3:E" & Derlig)
        T_colj = .Range("J3:J" & Derlig)
        T_cola = .Range("A3:A" & Derlig)
        For Cptr = 1 To UBound(T_colf)
            If Not D_retour.exists(T_cola(Cptr, 1)) Then
                T_colj(Cptr, 1) = "MAJ EN ATTENTE"
            Else
                If T_colf(Cptr, 1) = "pas de fax" Or T_colf(Cptr, 1) = 0 Then
                    T_colj(Cptr, 1) = 0
                Else
                    T_colj(Cptr, 1) = D_retour.Item(T_cola(Cptr, 1))
                End If
            End If
        Next
        ' a passer en "J3" apres essais
        .Range("K3").Resize(UBound(T_colj), 1) = T_colj
        .Activate
    End With
    
    Application.ScreenUpdating = True
    MsgBox "durée: " & Timer - Start & " secondes"

End Sub