Sub Centrage()
Dim Wks As Worksheet
Dim WorkRg As Range, CenterRg As Range
Dim FirstCell As Range, Lastcell As Range, FirstDimanche As Range
Dim NumSem As Byte
Dim CutSem As Boolean
Dim i As Byte
NumSem = 1: CutSem = False
For i = 1 To 12
Worksheets(i).Activate
CutSem = False
Set FirstCell = Range("C21")
Set Lastcell = Range("C21").End(xlToRight)
Set WorkRg = Range(FirstCell, Lastcell)
Do
On Error Resume Next
Set FirstDimanche = WorkRg(1, NumColDimanche(WorkRg))
If Err.Number <> 0 Then Set FirstDimanche = WorkRg(1, WorkRg.Count): CutSem = True
Set CenterRg = Range(WorkRg(1, 1).Offset(-2, 0), FirstDimanche.Offset(-2, 0))
On Error GoTo 0
With CenterRg
.Cells(1, 1) = "S" & NumSem
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Set WorkRg = Range(FirstDimanche.Offset(0, 1), Lastcell)
If Not CutSem Then NumSem = NumSem + 1
Loop Until FirstDimanche.Column = Lastcell.Column
Next i
End Sub
Function NumColDimanche(Rg As Range) As Byte
NumColDimanche = Application.Match("D", Rg, 0)
End Function