Sub test()
Dim i&, tablo, j&, n&, resu()
For i = 2 To Worksheets.Count
tablo = Worksheets(i).UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For j = 1 To UBound(tablo)
If UCase(tablo(j, 1)) = "NOM" Then
n = n + 1
ReDim Preserve resu(1 To n)
resu(n) = tablo(j, 2)
End If
Next j, i
'---restitution---
With Worksheets(1).[A2] 'adaptable
If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
If n Then .Resize(n) = Application.Transpose(resu) 'Transpose limitée à 65536 lignes
.Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
End Sub