Sub Test1 ()
Dim Suchergebnis As Range
Dim SuchWert As String
SuchWert = Range("D7")
With Worksheets("Datenbank").Range("U1:Z100")
Set Suchergebnis = .Find(SuchWert)
If Not Suchergebnis Is Nothing Then
Call Test2(Suchergebnis)
Else
Msgbox ("hier gibts nichts!")
End If
End With
End Sub
Sub Test 2 (Suchergebnis As Range)
Dim start As Long
Dim firstaddress
start = 6
firstaddress = Suchergebnis.Address
Do
Worksheets("Datenbank").Cells(Suchergebnis.Row, 1).Copy Worksheets("Tabelle7").Cells(6, start)
start = start + 6
Set Suchergebnis = .FindNext(Suchergebnis)
Loop While Not Suchergebnis Is Nothing And Suchergebnis.Address <> firstaddress
End Sub