Bonjour,
Votre macro modifiée:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim fbdd As Worksheet, ShKit As Worksheet
Dim i As Long
Dim cell As Range
Application.ScreenUpdating = False
Set ShKit = Sheets("KIT")
Set fbdd = Sheets("Base de Donné")
On Error GoTo Sortie 'pour remettre EnableEvents à True
Application.EnableEvents = False
If Target.Count > 1 Then GoTo Sortie 'pour remettre EnableEvents à True
If sh.Name <> fbdd.Name Then
If Not Intersect(Target, sh.Range("B4:B" & sh.Range("B" & sh.Rows.Count).End(xlUp).Row)) Is Nothing Then
Set cell = fbdd.Range("C2:C" & fbdd.Range("C" & Rows.Count).End(xlUp).Row).Find(Target, lookat:=xlWhole)
If cell Is Nothing Then
MsgBox "Cette référence ne figure pas dans la Bas de données", 16
GoTo Sortie 'pour remettre EnableEvents à True
End If
Cells(Target.Row, 4).ClearContents
For i = 2 To fbdd.Range("B" & Rows.Count).End(xlUp).Row
If UCase(fbdd.Range("C" & i)) = UCase(Target.Value) Then
sh.Cells(Target.Row, 4) = sh.Cells(Target.Row, 4) + fbdd.Range("H" & i)
End If
Next i
sh.Cells(Target.Row, 3) = cell.Offset(0, -1)
sh.Cells(Target.Row, 5).FormulaR1C1 = "=SUMIF(KIT!C2,RC2,KIT!C6)"
sh.Cells(Target.Row, 5).Value = sh.Cells(Target.Row, 5).Value
End If
End If
Sortie:
Application.EnableEvents = True
Set ShKit = Nothing
Set fbdd = Nothing
End Sub
Cdlt