Private Sub Worksheet_Activate()
Dim i As Long, derlig As Long, deb As Long
derlig = Range("D" & Rows.Count).End(xlUp).Row
Application.DisplayAlerts = False
deb = 8
For i = 8 To derlig Step 2
If Weekday(Range("E" & i).Value, 2) = 7 Or i >= derlig Then
Range(Cells(deb, 3), Cells(i + 1, 3)).Merge
Cells(deb, 3).FormulaR1C1 = "=WEEKNUM(RC[1],2)"
deb = i + 2
End If
Next
Application.DisplayAlerts = True
End Sub