So Ich habe es eingefügt und bei Ort2 die "" entfernt.

Es läuft zwar durch, hat aber absolut keine erkennbare Auswirkung.

Ich hatte gestern als Gast70296 (Vergessen Name einzutragen) noch etwas geschrieben.

Vieleicht kannst du es dir mal anschauen.

Ich versuche jetzt eine Beispieltabelle zu erstellen und sie in´s Netz zu stellen.

Dauert aber leider ein Moment.

Schon einmal Danke, das du dich des Problems annimmst.

Anbei der Code den ich ergänzt habe. Vieleicht habe ich ja auch etwas falsch gemacht.

 'Suche nach Teilstring (2)
  Dim rFinde2 As Range, rSuche2 As Range ' das ist mal eine einfache Variablendeklaration
  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) ' letzte volle Zeile in Sheet "Suchmeldungen" ermitteln, da stehen die Suchwerte in den Spalten von Spalte B
  End With
  Set rFinde2 = Sheets(Ort2).Range("E:E") ' wo soll gesucht werden, naja, in Spalte E Sheet Ort2, da stehen die zu vergleichenden Werte
  With Sheets("Wichtige Meldungen Prio 1")
    For I2 = 1 To lngLetzte2 ' Suchschleife, da ja mehr als nur ein Suchwert
       Set rSuche2 = rFinde2.Find(what:=.Cells(I2, 2), LookAt:=xlWhole) ' .cells.. ist der jeweilige Suchwert
          If Not rSuche2 Is Nothing Then ' wenn, was gefunden wurde
             strFirst2 = rSuche2.Address ' merke dir die erste gefundene Zelle (weil k?nnen ja mehr sein)
             Do ' weiter Schleife, um die anderen gleichen zu finden
               lngReihe2 = rSuche2.Row ' wir merken uns die Zeile wo in Sheet1 der Suchstring steht
               
               
               With Worksheets(Ort2)
     .Range("H" & rSuche2.Row).Value = rSuche2.Offset(0, -2).Value  '*** Wert aus der entsprechenden Zelle "C" & Suchzeile
     .Range("I" & rSuche2.Row).Value = rSuche2.Offset(0, 2).Value'***  Zelle "G" & Suchzeile in Zell "I" & gefundene Zeile
End With
               
               
               Sheets(Ort2).Range("A" & lngReihe2).EntireRow.Interior.ColorIndex = 40 ' wir f?rben diese Zeile komplett Rosa ein
               Set rSuche2 = rFinde2.FindNext(rSuche2) ' wir suchen den n?chsten, gleichen Suchstring
             Loop While Not rSuche2 Is Nothing And rSuche2.Address <> strFirst2 'das tun wir solange, bis wir wieder bei der ersten Adresse sind und somit alle gefunden wurden.
          End If
      Next I2
  End With

Danke 

Bernd