Sub test()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim anzahl As Integer
For i = 11 To 5000
For y = 1 To 52
If ActiveSheet.Cells(i, 1).Value <> "" Then
ActiveSheet.Cells(i + 1, 1).EntireRow.Insert
ActiveSheet.Range("A" & i & ":G" & i).Copy ActiveSheet.Range("A" & i + 1)
ActiveSheet.Range("H" & i + 1).Value = ActiveSheet.Cells(8, 9 + y).Value
ActiveSheet.Range("I" & i + 1).Value = ActiveSheet.Cells(i, 9 + y).Value
End If
Next y
i = i + 52
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub