Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsDate("1/" & Sh.Name) Then Exit Sub
Dim ncol%, lig&, nligsem&, maxi&, col%, dat&, n As Variant, i&, j%
ncol = 3 'nombre de colonnes d'un jour
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille
On Error Resume Next: .ShowAllData: On Error GoTo 0
.[Z1] = 1
.UsedRange.Columns(26).DataSeries 'numérotation des lignes
.UsedRange.Sort .[A1], Header:=xlYes 'tri sur les dates
For lig = Range("A1", Sh.UsedRange).Rows.Count To 1 Step -1
If Cells(lig, 1) Like "Sem*" Then
nligsem = Cells(lig, 1).MergeArea.Count - 1
Cells(lig + 1, 2).Resize(nligsem, 5 * ncol) = "" 'RAZ
maxi = 2 'au moins 2 lignes
For col = 2 To 5 * ncol + 1 Step ncol
dat = Cells(lig, col)
n = Application.Match(dat, .[A:A], 0)
If IsNumeric(n) Then
i = 1
Do
If i > maxi Then maxi = i
If i > nligsem Then
Rows(lig + i - 1).Insert
Rows(lig + i).Copy Rows(lig + i - 1)
nligsem = nligsem + 1
End If
For j = 1 To ncol
Cells(lig + i, col + j - 1) = .Cells(n, j + 1)
Next j
i = i + 1: n = n + 1
Loop While .Cells(n, 1) = dat
End If
Next col
If nligsem > maxi Then Rows(lig + maxi + 1).Resize(nligsem - maxi).Delete
End If
Next lig
.UsedRange.Sort .[Z1], xlAscending 'ordre initial
.[Z:Z] = ""
With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub