Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim lig&, c As Range
Application.ScreenUpdating = False
[C1:J2] = "" 'RAZ
Rows("3:" & Rows.Count).Delete 'RAZ
lig = 2
On Error Resume Next
With Sheets(CStr([B2]))
[C1] = .[B5]: [H1] = .[H5]
[C2:I2] = .[B6:H6].Value
For Each c In .[A:A].SpecialCells(xlCellTypeConstants)
If c = "Matin" Or c = "Après-Midi" Then
lig = lig + 1
Cells(lig, 3).Resize(, 7).Merge
Cells(lig, 3).Resize(, 7).Font.Bold = True
Cells(lig, 3).Resize(, 7).Interior.ColorIndex = IIf(c = "Matin", 6, 44)
Cells(lig, 3) = c.Value
ElseIf c = [B1] Then
1 If Application.CountA(c(1, 2).Resize(, 7)) Then
lig = lig + 1
Cells(lig, 3).Resize(, 7) = c(1, 2).Resize(, 7).Value
If c(2) = "" Then Set c = c(2): GoTo 1
End If
End If
Next
End With
Intersect([C:I], UsedRange).Borders.Weight = xlThin
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B1:B2]) Is Nothing Then Worksheet_Activate
End Sub