XL 2019 Temps éxécution très long sur un userform

    'Report sur le calendrier
    Application.Calculation = xlCalculationManual
    For i = 12 To DerCol_f1 Step 3
        Range(f1.Cells(4, i), f1.Cells(34, i)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],Trame5x8!R1C1:R" & DerLig_f2 & "C3,3,0),"""")"
        Range(f1.Cells(4, i), f1.Cells(34, i)).Value = Range(f1.Cells(4, i), f1.Cells(34, i)).Value
    Next i
    Application.Calculation = xlCalculationAutomatic

On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)

Sub Recherche_Depart5x8_dans_Trame5x8()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Calcul 5x8")
    Set f2 = Sheets("Trame5x8")
    DerCol_f1 = f1.Range("XFD3").End(xlToLeft).Column + 2
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("C1:C" & DerLig_f2).ClearContents
    d = Application.WorksheetFunction.Match(Date_Depart5x8, f2.Range("A1:A" & DerLig_f2), 0)
    On Error GoTo Gere_Erreurs
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    'Placement des "congés" 7
    If Conges5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = Conges5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 7
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "Divers congés" 6,9,5,8
    If DiversConges5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = DiversConges5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 6
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "JoursRecuperation" 9,5,8
    If JoursRecuperation5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = JoursRecuperation5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 9
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "JoursEpargnes" 5,8
    If JoursEpargnes5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = JoursEpargnes5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 5
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Placement des "TroisQuartTemps" 8
    If TroisQuartTemps5x8 > 0 Then
        Do While f2.Cells(d, "B") = 0
            d = d - 1
        Loop
        For i = TroisQuartTemps5x8 To 1 Step -1
            If f2.Cells(d, "B") <> 0 Then
                f2.Cells(d, "C") = 8
            Else
                i = i + 1
            End If
            d = d - 1
        Next
    End If
   
    'Report sur le calendrier
    For i = 12 To DerCol_f1 Step 3
        Range(f1.Cells(4, i), f1.Cells(34, i)).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],Trame5x8!R1C1:R" & DerLig_f2 & "C3,3,0),"""")"
        Range(f1.Cells(4, i), f1.Cells(34, i)).Value = Range(f1.Cells(4, i), f1.Cells(34, i)).Value
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
    MsgBox "Projection terminée", vbOKOnly + vbInformation
Gere_Erreurs:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub