Macro de remplissage trop lourde

Sub BulkData()
  Dim I As Long
  Dim ShL As Worksheet
  Dim Cel As Range
  
  ' Désactiver les recalculs
  Application.Calculation = xlCalculationManual
  ' Désactiver le déclenchement des évènements
  Application.EnableEvents = False
  Set ShL = Sheets("Sheet2")
  With Sheets("BULK EQPT")
    For I = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      Set Cel = ShL.Columns("A:A").Find(.Range("D" & I), LookIn:=xlValues, Lookat:=xlWhole)
      If Not Cel Is Nothing Then
        .Range("E" & I) = ShL.Range("B" & Cel.Row)
        .Range("F" & I) = ShL.Range("C" & Cel.Row)
        .Range("G" & I) = ShL.Range("D" & Cel.Row)
        .Range("H" & I) = ShL.Range("E" & Cel.Row)
        .Range("I" & I) = ShL.Range("F" & Cel.Row)
        .Range("J" & I) = ShL.Range("G" & Cel.Row)
        .Range("K" & I) = ShL.Range("H" & Cel.Row)
        .Range("L" & I) = ShL.Range("I" & Cel.Row)
        .Range("M" & I) = ShL.Range("J" & Cel.Row)
        .Range("N" & I) = ShL.Range("K" & Cel.Row)
        .Range("O" & I) = ShL.Range("L" & Cel.Row)
        .Range("P" & I) = ShL.Range("M" & Cel.Row)
        .Range("Q" & I) = ShL.Range("N" & Cel.Row)
        .Range("R" & I) = ShL.Range("O" & Cel.Row)
      End If
    Next I
  End With
  ' Activer les recalculs
  Application.Calculation = xlCalculationAutomatic
  ' Activer le déclenchement des évènements
  Application.EnableEvents = True
End Sub

Sub BulkData()
    Dim L As Long, Tbl As Variant
    Dim Cel As Range
    Dim C As Integer

    With Application
        ' Désactiver les recalculs
        .Calculation = xlCalculationManual
        ' Désactiver le déclenchement des évènements
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    With Sheets("BULK EQPT")
        Tbl = .Range("D2:R" & .Range("D65536").End(xlUp).Row)
    End With

    With Worksheets("Sheet2")
        For L = 1 To UBound(Tbl, 1)
            Set Cel = .Columns("A:A").Find(Tbl(L, 1), LookIn:=xlValues, Lookat:=xlWhole)
            If Not Cel Is Nothing Then
                For C = 2 To UBound(Tbl, 2)
                    Select Case C
                    Case 4
                        Tbl(L, C) = .Cells(Cel.Row, C) & "*" 'pour éviter changement en date
                    Case Else
                        Tbl(L, C) = .Cells(Cel.Row, C)
                    End Select
                Next
            End If
        Next L
    End With

    With Sheets("BULK EQPT")
        .Range("D2").Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl
    End With

    With Application
        ' Activer les recalculs
        .Calculation = xlCalculationAutomatic
        ' Activer le déclenchement des évènements
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub