Sub ChercherCopierColler()
Dim chaine As String
Dim c As Range
chaine = InputBox("Chaine à trouver")
If chaine = "" Then Exit Sub
With Sheets("Feuil1")
Set c = .Range("B:B").Find(what:=chaine, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False)
If Not c Is Nothing Then
c.[COLOR=red][B]CurrentRegion[/B][/COLOR].Copy Destination:=Sheets("Feuil2").Cells(.Rows.Count, 2).End(xlUp)(3).Offset(, -1)
End If
End With
End Sub