Hi ralf_b

Danke für Deinn Input.....

AHHH ja, hab gerade bemerkt, dass ich den Falschen Code eingefügt habe, aber der erste ist im selben Arbeitsblatt.

1.Und wie könnte ich die unschöne Verzögerung umgehen?

2. Folgende zwei würde ich gerne integrieren:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
  If Not Application.Intersect(Range("L8:M1000"), Target) Is Nothing Then
     Select Case UCase$(Target.Value)
     Case "NB"
         MsgBox "Begründung warum keine Schulung benötigt wird unter Bemerkung eintragen.", _
         vbOKOnly + vbExclamation, "Sicherheitsschulung nicht benötigt!"
     
     Case ".NEIN"
         MsgBox "Begründung warum Ausweis nicht Kontrolliert wurde unter Bemerkung eintragen." & "" _
         & vbCrLf & "", _
 _
         vbOKOnly + vbExclamation, "Keine Ausweiskontrolle!"
     
     Case "NEIN"
         MsgBox "Es wird eine Schulung oder ein Refresh benötigt." & "" _
         & vbCrLf & "Kontaktperson darüber informieren und die entsprechenden Dokumente vorbereiten.", _
 _
         vbOKOnly + vbExclamation, "Sicherheitschulung nicht vorhanden / abgelaufen!"
     End Select
  End If
On Error GoTo 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'bearbeiten mehrerer Zeilen wird abgefangen
    If Target.Count > 1 Then Exit Sub
 
    If Intersect(Target, Range("D8:D1000,Q8:P1000")) Is Nothing Then Exit Sub
 
 
    If Target.Value = "Name1" Or Target.Value = "Name2" Or Target.Value = "Name3" Or Target.Value = "Name4" Or Target.Value = "Name5" Or Target.Value = "Name6" Then
     
Target.Offset(0, 1) = Format(Date, "dd.mm.yyyy")
    Target.Offset(0, 2) = Format(Time, "hhmm")
    Else
    Target.Offset(0, 1).ClearContents
    Target.Offset(0, 2).ClearContents
 
    End If
 
    End Sub

lg Markus