Excuse moi de te déranger encore
J'ai accès au code mais il ne s'exécute pas
Peut être manque t-il un élément ?
Option Explicit
Dim tablo, tablor()
Dim i&, j&, k&
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$1" Then
tablo = Range("A2:M" & Range("H" & Rows.Count).End(xlUp).Row)
k = 1
For i = 1 To UBound(tablo, 1)
If UCase(tablo(i, 8)) = UCase(Target) Then
ReDim Preserve tablor(1 To UBound(tablo, 2), 1 To k + 1)
For j = 1 To UBound(tablo, 2)
tablor(j, k) = tablo(i, j)
Next j
k = k + 1
End If
Next i
End If
Sheets("Feuil3").Cells.ClearContents
On Error GoTo fin
Sheets("Feuil3").Range("A2").Resize(UBound(tablor, 2), UBound(tablo, 2)) = Application.Transpose(tablor)
Sheets("Feuil3").Activate
fin:
End Sub