Hallo zusammen,

folgender Code trägt in der Schleife den String "Zustellung lt. QSTATUS" leider in jede entsprechende Zelle mehrfach ein:

Sub EinfacheFinden()
Dim Zelle As Range
Static LastRow As Long
Dim letzteZeile As Long
Dim Bereich As Range
Dim SpalteA As Range
Dim letzteA As Long
Dim ZelleA As Range

    If LastRow = 0 Then LastRow = 1

    letzteZeile = ActiveSheet.Cells(Rows.Count, 13).End(xlUp).Row
    letzteA = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set Bereich = ActiveSheet.Range("M2:M" & letzteZeile)
    Set SpalteA = ActiveSheet.Range("A2:A" & letzteA)
    
    For Each ZelleA In SpalteA
    
        If ZelleA.Value <> "Nie gelaufen" Or ZelleA.Value <> "Verlust" _
            Or ZelleA.Value <> "Außer Kontrolle" Or ZelleA.Value <> "AbhNr*" Or ZelleA.Value <> "" Then

        For Each Zelle In Bereich

        
        
        If WorksheetFunction.CountIf(Bereich, Zelle.Value) = 1 Then
            With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 16))
                    .Interior.Color = RGB(154, 205, 50)
                    LastRow = .Row
            End With
                
            With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 1))
                    .Value = "Zugestellt"
                    LastRow = .Row
                    
            End With
            
            With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 1))
               
                If .CommentThreaded Is Nothing Then
                    .AddCommentThreaded "Zugestellt lt. QSTATUS"
                Else
                    .CommentThreaded.AddReply "Zugestellt lt. QSTATUS"
                End If
            End With

        End If
    Next Zelle
        End If
    Next ZelleA
End Sub

Was habe ich hier falsch gemacht?

LG Bobby