Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
If Not Intersect(Range("D12"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1) = WorksheetFunction.SumIf(Range("B3:B7"), Target, Range("E3:E7"))
End If
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub