Private Sub Worksheet_Activate()
Dim tablo(), c As Range, n&, c1 As Range
ReDim tablo(1 To Rows.Count, 1 To 1) 'matrice, plus rapide
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
Range("B3:B" & Rows.Count).Clear 'RAZ
For Each c In Sheets("données").Columns(1).SpecialCells(xlCellTypeConstants)
If c <> "" Then
n = 0
For Each c1 In c(1, 2).Resize(c.MergeArea.Count).SpecialCells(xlCellTypeConstants)
n = n + 1
tablo(n, 1) = c1(1, 2) & c1
Next c1
Set c1 = Range("B" & Rows.Count).End(xlUp)(2)
If c1.Row < 3 Then Set c1 = Range("B3")
c1.Resize(n) = tablo
c1.Resize(n).Font.Color = c.Font.Color 'couleur police
End If
Next c
End Sub