Suchbegriff FETT markieren

Alle Datenbankzeilen, in welchen der Suchbegriff vorkommt, werden in einer neuen Tabelle ausgeworfen.

Gibt es eine Möglichkeit, dass jene Textteile der neuen Auswertungstabelle, die dem Suchbegriff entsprechen, FETT gedruckt dargestellt werden.

Bei den Suchbegriffen handelt es sich um Werte!

CODE:
Option Explicit
Sub DoppelFilter()
Dim inRoQ As Long, inRoZ As Long, i As Long, eZ As Long
Dim blaNaQ As String, blaNaZ As String
Dim SuBe As Variant
Dim konvSuBe As Variant
On Error GoTo TestError

SuBe = InputBox("Suchbegriff eingeben:" & Chr(10) & " " & Chr(10) & _
"(Das Suchergebnis wird in einem neuen Tabellenblatt angezeigt.)", _
"SUCHABFRAGE")

If SuBe = "" Then
MsgBox "Makro-Abbruch wegen fehlendem Suchbegriff!", , _
"MAKROABBRUCH"
Range("A1").Select
Exit Sub
End If
Application.ScreenUpdating = False
konvSuBe = (UCase(SuBe))
blaNaQ = ActiveSheet.Name
Rows("3:3").Select
Selection.Autofilter
blaNaZ = "Suchergebnis " & konvSuBe
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = blaNaZ
Sheets(blaNaQ).Select
inRoQ = Cells(Rows.Count, 2).End(xlUp).Row
eZ = 0
For i = 1 To inRoQ Step 1
If InStr(UCase(Cells(i, 3).Value), konvSuBe) > 0 Or _
InStr(UCase(Cells(i, 7).Value), konvSuBe) > 0 Then
eZ = eZ + 1
With Worksheets(Sheets.Count)
inRoZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If eZ = 1 Then inRoZ = 1
.Cells(inRoZ, 1).Value = Cells(i, 1).Value
.Cells(inRoZ, 2).Value = Cells(i, 2).Value
.Cells(inRoZ, 3).Value = Cells(i, 3).Value
.Cells(inRoZ, 4).Value = Cells(i, 4).Value
.Cells(inRoZ, 5).Value = Cells(i, 5).Value
.Cells(inRoZ, 6).Value = Cells(i, 6).Value
.Cells(inRoZ, 7).Value = Cells(i, 7).Value
.Cells(inRoZ, 8).Value = Cells(i, 8).Value
' .Cells(inRoZ, 9).Value = Cells(i, 9).Value
' .Cells(inRoZ, 10).Value = Cells(i, 10).Value
' .Cells(inRoZ, 11).Value = Cells(i, 11).Value
End With
End If
Next i
Sheets(blaNaZ).Select
If eZ = 0 Then
MsgBox _
"Es wurden keine Zellen mit dem Suchbegriff *" & konvSuBe & "* gefunden !", , _
"SUCHERGEBNIS"
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets(blaNaQ).Select
Rows("3:3").Select
Selection.Autofilter
Range("A4").Select
Else
Sheets(blaNaQ).Select 'Auswertung Formatieren
Rows("1:3").Select
Selection.Copy
Sheets(blaNaZ).Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Sheets(blaNaQ).Select
Application.CutCopyMode = False
Rows("3:3").Select
Selection.Autofilter
Columns("A:L").Select
Selection.Copy
Range("A4").Select
Sheets(blaNaZ).Select
Columns("A:L").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1:A2").Select
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1:A2000").Select
Selection.EntireRow.Delete
Range("D4").Select
ActiveWindow.FreezePanes = True
Range("A1:A2").Select
ActiveWindow.DisplayHeadings = False
MsgBox _
"Es wurde(n) " & eZ & " Zeile(n) mit dem Suchbegriff *" & konvSuBe & "* gefunden !" & _
"" & Chr(10) & " " & Chr(10) & _
"Falls das Seiten-Layout für einen Ausdruck eingerichtet werden soll, bestätigen Sie mit OK und drücken Sie anschließend STRG+SHIFT+Q !", , _
"SUCHERGEBNIS"
End If
Application.ScreenUpdating = True
Exit Sub
TestError:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Sheets(blaNaQ).Select
Range("A4").Select
MsgBox "Eine Auswertung für den Suchbegriff *" & konvSuBe & "* liegt bereits vor!"
End Sub

Gruß und ein dickes(fettes) Dankeschön
Klaus