Programm

Sub SuchenUndAusgeben()
Dim wks As Worksheet, sh As Worksheet
Dim rng As Range
Dim intC As Integer, intRow As Integer
Dim sFind As String, myStr As String
Set wks = ActiveSheet
sFind = InputBox("Bitte Suchbegriff eingeben!", "SUCHE", "")
If sFind = "" Then Exit Sub
For Each sh In ThisWorkbook.Worksheets
Set rng = sh.Cells.Find(What:=sFind, LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
For intC = 1 To 27
myStr = myStr & Format(intC, "00") & ". " & sh.Cells(intC, rng.Column) & vbLf
Next intC
intRow = intRow + 1
wks.Cells(intRow, 1).Value = myStr
myStr = ""
End If
Next sh
End Sub