Private Sub Worksheet_Activate()
Dim w As Worksheet, nom$, a, t(), i&, j&, h&
Application.ScreenUpdating = False
For Each w In Worksheets
nom = w.Name
If nom Like "CS*" Then 'critère à adapter éventuellement
With w.[B146].CurrentRegion.Offset(1).Resize(, 4)
a = .Value2 '.Value2 important pour les dates
ReDim Preserve t(1 To 5, 1 To h + .Rows.Count) 'tableau transposé
End With
For i = 1 To UBound(a) - 1
j = h + i
t(1, j) = a(i, 1)
t(2, j) = nom
t(3, j) = a(i, 2)
t(4, j) = a(i, 3)
t(5, j) = a(i, 4)
Next
h = h + i - 1
End If
Next
Range("B20:F" & Rows.Count).ClearContents 'RAZ
If h Then
[B20].Resize(h, 5) = Application.Transpose(t) 'avec Transpose maximum 65536 lignes
[B20].Resize(h, 5).Sort [B20], xlAscending, [C20], , xlAscending, Header:=xlNo 'tri sur les dates
End If
End Sub