Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim c As Range, h%, mem, t(), txt$, n%, w As Worksheet, tablo
For Each c In Range("B5", Range("B" & Rows.Count).End(xlUp))
If c <> "" Then
h = c.MergeArea.Count
mem = c(1, 4).Resize(h, 2).Formula 'mémorise
ReDim t(1 To h, 1 To 6)
txt = c
n = 0
For Each w In Worksheets
If w.Name Like "T#*" Then
tablo = w.Range("B20", w.Range("K" & w.Rows.Count).End(xlUp))
Call Copie(h, t, txt, n, tablo)
tablo = w.Range("N20", w.Range("W" & w.Rows.Count).End(xlUp))
Call Copie(h, t, txt, n, tablo)
End If
Next
c(1, 3).Resize(h, 6) = t
c(1, 4).Resize(h, 2) = mem
End If
Next
End Sub
Sub Copie(h%, t, txt$, n%, tablo)
Dim i&
For i = 1 To UBound(tablo)
If tablo(i, 2) = "J" And tablo(i, 10) = txt Then
n = n + 1
If n > h Then Exit For
t(n, 1) = tablo(i, 1)
t(n, 4) = tablo(i, 5)
t(n, 5) = tablo(i, 7)
t(n, 6) = tablo(i, 8)
End If
Next
End Sub