Dim Suchergebnis As Range
Dim SuchWert As String
Dim start As Long
Dim firstaddress
SuchWert = Range("C16")
start = 2
With Worksheets("Datenbank").Range("A1:A300")
Set Suchergebnis = .Find(SuchWert)
If Not Suchergebnis Is Nothing Then
firstaddress = Suchergebnis.Address
Do
Worksheets("Datenbank").Cells(Suchergebnis.Row, 1).Copy Worksheets("Ausgabe").Cells(7, start)
start = start + 2
Set Suchergebnis = .FindNext(Suchergebnis)
Loop While Not Suchergebnis Is Nothing And Suchergebnis.Address <> firstaddress
Else
MsgBox "Diese Datenbank verzeichnet keine Person mit Ihrer angefragten Befugnis."
End If
End With
End Sub