Makro anpassen

Sub PersonalNummer()
'Makro Personalnummer soviel wie an Monatspäckchen vorhanden
Worksheets("Einteiler").Activate
Range("D5").Select
j = 2
letzterTag = 0
aktuellerTag = 1
For i = 1 To 130
PersNr = Worksheets("Dummy").Range("f" & i)
Do While aktuellerTag > letzterTag
ActiveSheet.Range("d5" & j).Value = PersNr
j = j + 1
letzterTag = Range("f" & j).Offset(-1, 1).Value
aktuellerTag = Range("f" & j).Offset(0, 1).Value
Loop
letzterTag = 0
Next i
End Sub