Dim rFinde2 As Range, rSuche2 As Range
Dim strFirst2 As String
Dim lngReihe2 As Long, lngLetzte2 As Long
Dim I2 As Integer
With Sheets("Wichtige Meldungen Prio 1")
lngLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
_
Count)
End With
Set rFinde2 = Sheets(Ort2).Range("E:E")
With Sheets("Wichtige Meldungen Prio 1")
For I2 = 1 To lngLetzte2
Set rSuche2 = rFinde2.Find(what:=.Cells(I2, 2), LookAt:=xlWhole)
If Not rSuche2 Is Nothing Then
strFirst2 = rSuche2.Address
Do
lngReihe2 = rSuche2.Row
Sheets(Ort2).Range("A" & lngReihe2).EntireRow.Interior.ColorIndex = 40
Set rSuche2 = rFinde2.FindNext(rSuche2)
Loop While Not rSuche2 Is Nothing And rSuche2.Address <> strFirst2
End If
Next I2
End With