Option Explicit
Sub Essai3()
Application.ScreenUpdating = 0: Worksheets(5).Select
Dim nlm&, dl1&, dl2&: nlm = Rows.Count
With Worksheets(4)
Dim cel As Range, ech$, lg1&, lg2&
dl2 = .Cells(nlm, 5).End(3).Row: If dl2 = 1 Then Exit Sub
dl1 = Cells(nlm, 6).End(3).Row: Application.Calculation = -4135
If dl1 > 1 Then 'effacement des anciens résultats
With Range("F2:F" & dl1): .ClearContents: .Borders.LineStyle = -4142: End With
End If
dl1 = Cells(nlm, 2).End(3).Row: If dl1 = 1 Then GoTo 1
For lg1 = 2 To dl1
Set cel = Cells(lg1, 2): ech = Left$(cel.Offset(, 1), 4)
For lg2 = 2 To dl2
If cel = .Cells(lg2, 3) And ech = Left$(.Cells(lg2, 1), 4) Then
cel.Offset(, 4) = cel.Offset(, 4) + .Cells(lg2, 5)
End If
Next lg2
Next lg1
1 Range("F2:F" & dl1).Borders.LineStyle = 1: Application.Calculation = -4105
End With
End Sub