Sub Conso()
Dim lavaleur As String, Cell As Range, ligne As Integer
Dim col As Byte
Dim dest As Range
' Quitte si la cellule est vide
If ActiveCell.Value = "" Then Exit Sub
lavaleur = ActiveCell.Value
col = ActiveCell.Column
For Each Cell In Range(Cells(1, col), Cells(65536, col).End(xlUp))
If Cell.Value = lavaleur Then
Set dest = Sheets("trouvé").Range("A65536").End(xlUp).Offset(1, 0)
Cell.EntireRow.Copy Destination:=dest
End If
Next Cell
Sheets("trouvé").Activate
End Sub