Bitte um Hilfe von Rudi Maintaire

Sub Pläne_markieren()
Dim rngMatch As Range, rngC As Range, rngA As Range
Dim lngCol As Long, i As Integer
Application.ScreenUpdating = False
With Tabelle2
Set rngMatch = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each rngA In Tabelle1.UsedRange.Cells
rngA.Font.Color = 0
For Each rngC In rngMatch
lngCol = rngC.Font.Color
i = InStr(rngA, rngC)
If i > 0 Then
With rngA.Characters(i, Len(rngC)).Font
.Color = lngCol
.Bold = True
.Italic = True
End With
End If
Next rngC
Next rngA
End Sub