Sub fillweeks()
For i = 73 To 1200
If Weekday(CDate(Cells(1, i)), vbMonday) = 1 And Weekday(CDate(Cells(1, i + 1)), vbMonday) = 1 Then
j = 0
For h = 1 To 6
Columns(i + h).Insert Shift:=xlToRight
Cells(1, i + h) = Cells(1, i) + h
Next
End If
If Cells(1, i) = "" Then
Exit For
End If
Next
End Sub