Sub test()
Dim Gruppennummer_Analyse As Range
Dim firstAddress
Dim lngZiel As Long
Dim i As Integer
lngZiel = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 10
With Worksheets("Tabelle1")
Set Gruppennummer_Analyse = .Columns(5).Find(i, LookIn:=xlValues, lookat:=xlWhole)
If Not Gruppennummer_Analyse Is Nothing Then
firstAddress = Gruppennummer_Analyse.Address
Do
Cells(lngZiel, 1).Value = .Cells(Gruppennummer_Analyse.Row, 5)
Cells(lngZiel, 2).Value = .Cells(Gruppennummer_Analyse.Row, 6)
lngZiel = lngZiel + 1
Set Gruppennummer_Analyse = .Columns(5).FindNext(Gruppennummer_Analyse)
Loop While Not Gruppennummer_Analyse Is Nothing And Gruppennummer_Analyse.Address <> firstAddress
End If
End With
Next
End Sub