Hallo zusammen, ich habe folgenden Code an dem ich gerade verzweifel:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next ' Fehlerbehandlung deaktivieren

Dim ws As Worksheet
Dim checkRange As Range
Dim checkRange1 As Range
Dim rowNum As Long
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim mailSubject As String
Dim mailBody As String
Dim reminderDate As Date
Dim calendarEvent As Object ' Variable für den Kalendereintrag

' Definiere das Arbeitsblatt, auf dem die Tabelle liegt
Set ws = ThisWorkbook.Worksheets("Kapazitäts_Eingabe")
Set checkRange = Sh.Range("A:A")
Set checkRange1 = Sh.Range("D:D")

If Sh.Name = "Kapazitäts_Eingabe" Then
' Überprüfe, ob die geänderte Zelle innerhalb des überwachten Bereichs liegt
If Not Intersect(Target, checkRange) Is Nothing Then
' Ermittele die Zeilennummer der geänderten Zelle
rowNum = Target.Row

' Überprüfe, ob "Auftrag" in der geänderten Zelle steht
If StrComp(UCase(Target.Value), "AUFTRAG", vbTextCompare) = 0 Then ' vbTextCompare für die Groß-/Kleinschreibung-unabhängige Überprüfung
' Wenn "Auftrag" gefunden wurde, setze den Wert in der 3. Zeile auf 100%
ws.Cells(rowNum, 3).Value = "100%" ' 1 entspricht 100%
End If
End If
End If


If Sh.Name = "Kapazitäts_Eingabe" Then
' Überprüfe, ob die geänderte Zelle innerhalb des überwachten Bereichs liegt
If Not Intersect(Target, checkRange1) Is Nothing Then
' Ermittele die Zeilennummer der geänderten Zelle
rowNum = Target.Row

' Überprüfen, ob in derselben Zeile in Spalte A (1) das Wort "Angebot" steht
If Sh.Cells(Target.Row, 1).Value = "Angebot" Then
' Überprüfen, ob der geänderte Wert "verloren" oder "abgelehnt" ist
If LCase(Target.Value) = "verloren" Or LCase(Target.Value) = "abgelehnt" Then
' Popup-Fenster anzeigen
ws.Cells(rowNum, 3).Value = "0%" ' 1 entspricht 0%
answer = MsgBox("Angebot nicht mehr relevant? Eventuelle Planungsdaten löschen?", vbYesNo + vbQuestion, "Bestätigung")

' Handhabung der Antwort
If answer = vbYes Then
' Wenn Ja ausgewählt wurde, die Zeile von U an leeren
Set rng = Sh.Range("U" & Target.Row & ":XFD" & Target.Row)
rng.ClearContents
End If
End If
End If
End If
End If

If Sh.Name = "Kapazitäts_Eingabe" Then
' Überprüfen, ob die Änderung in der Spalte "Status" stattgefunden hat
If Not Intersect(Target, checkRange1) Is Nothing Then
' Ermittele die Zeilennummer der geänderten Zelle
rowNum = Target.Row

' Überprüfe, ob "erledigt" in der geänderten Zelle steht
If StrComp(UCase(Target.Value), "ERLEDIGT", vbTextCompare) = 0 Then ' vbTextCompare für die Groß-/Kleinschreibung-unabhängige Überprüfung wenn "erledigt" gefunden wurde

' E-Mail-Versand
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

' Hier müssen Sie den Namen der E-Mail-Empfänger einsetzen (XXXXX)
OutlookMail.To = "xxx@xxx.com"

' Hier können Sie den E-Mail-Betreff anpassen
mailSubject = "Wartungsvertragsstatus prüfen " & ws.Cells(Target.Row, 6).Value & " "
OutlookMail.Subject = mailSubject

' Hier wird der E-Mail-Text zusammengesetzt, der die betroffenen Informationen enthält
mailBody = "Das Projekt " & ws.Cells(Target.Row, 5).Value & " (Auftr.Nr.: " & ws.Cells(Target.Row, 6).Value & ")" & _
" wurde als erledigt deklariert, bitte Status Wartungsvertrag überprüfen."
OutlookMail.Body = mailBody

' Kalendereintrag erstellen
reminderDate = DateAdd("ww", 3, Now()) ' Datum für die Erinnerung (3 Wochen später)
Set calendarEvent = OutlookApp.CreateItem(1) ' 1 für Kalendereintrag
With calendarEvent
.Subject = mailSubject
.Start = reminderDate
.End = reminderDate
.AllDayEvent = True
.ReminderSet = True
.ReminderMinutesBeforeStart = 15 ' Erinnerung 15 Minuten vorher
.Body = mailBody
.Save ' Speichern des Kalendereintrags
End With

' E-Mail-Anhang hinzufügen (den Kalendereintrag)
OutlookMail.Attachments.Add calendarEvent

' E-Mail senden
OutlookMail.Send

' Freigeben der Ressourcen
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End If
End If
End If

On Error GoTo 0 ' Fehlerbehandlung wieder aktivieren
Exit Sub
End Sub


An für sich funktioniert alles einwandfrei, das Problem das ich habe ist das er jedes mal wenn eine Zeile gelöscht oder hinzugefügt wird ebenfalls ausgeführt wird. D.h. ich bekomme bei löschen oder hinzufügen eine Email. Kann mir jemand veraten wie ich das verhindern kann?

Würde mich hier sehr über Hilfestellung freuen, bin da schon länger dran und kläglich gescheitert.