Sub Groupagesemaine()
Dim i
Application.ScreenUpdating = False
For i = 5 To 369
Do While ActiveSheet.Cells(6, i) = 1
i = i + 1
Loop
If Weekday(Cells(8, i), vbMonday) = 2 Then
ActiveSheet.Range(Cells(8, i), Cells(8, i + 5)).Select
Selection.Columns.Group
End If
If ActiveSheet.Cells(6, i) = 53 Then GoTo FinProg
Next i
FinProg:
Columns("E:NE").EntireColumn.AutoFit
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Application.ScreenUpdating = True
MsgBox ("Groupage des Semaines Réalisé")
End Sub