Private Sub Worksheet_Activate()
Dim col, d As Object, w As Worksheet, P As Range, colLibel As Variant, colDate As Variant, t, j%, a, b, ub%, i&, n&, resu()
col = Array("F", "G", "H", "I") 'liste des colonnes, à adapter
Set d = CreateObject("Scripting.Dictionary")
For Each w In Worksheets
If w.Name <> Me.Name Then
Set P = w.[A1].CurrentRegion
colLibel = Application.Match("Libellé", P.Rows(1), 0)
colDate = Application.Match("Date", P.Rows(1), 0)
t = P.Resize(P.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
For j = 1 To UBound(t, 2)
If IsNumeric(Application.Match(t(1, j), col, 0)) Then d(t(1, j)) = j 'mémorise la colonne
Next j
If d.Count Then
a = d.keys: b = d.items: ub = UBound(a)
For i = 2 To UBound(t) - 1
For j = 0 To ub
If t(i, b(j)) <> "" Then
n = n + 1
ReDim Preserve resu(1 To 4, 1 To n)
If IsNumeric(colDate) Then resu(1, n) = t(i, colDate) Else resu(1, n) = ""
If IsNumeric(colLibel) Then resu(2, n) = t(i, colLibel) Else resu(2, n) = ""
resu(3, n) = a(j)
resu(4, n) = t(i, b(j))
End If
Next j, i
d.RemoveAll 'RAZ du Dictionary
End If
End If
Next w
If n Then
'---transposition---
ReDim t(1 To n, 1 To 4)
For i = 1 To n
For j = 1 To 4
t(i, j) = resu(j, i)
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
[A2].Resize(n, 4) = t
End If
[A2].Offset(n).Resize(Rows.Count - n - 1, 4).ClearContents 'RAZ sous le tableau
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub