Sub test()
Dim lngZiel As Long
Dim strFirst As String
Dim c As Range
With Sheets("Tabelle2")
lngZiel = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
If lngZiel <= 52 Then lngZiel = 52
Set c = Columns(9).Find("ja", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
strFirst = c.Address
Do
.Cells(lngZiel, 3).Value = Cells(c.Row, 4).Value
lngZiel = lngZiel + 1
Set c = Columns(9).FindNext(c)
Loop While Not c Is Nothing And c.Address <> strFirst
End If
End With
End Sub