Sub JeCherche()
Dim xlWbk As Workbook
Dim xlWsh As Worksheet
Dim lastRow As Long
Dim strCrit As Variant
Dim i As Integer, j As Integer
Set xlWbk = ThisWorkbook
Set xlWsh = xlWbk.Worksheets("Feuil1")
lastRow = xlWsh.Cells(xlWsh.Rows.Count, 1).End(xlUp).Row
strCrit = xlWsh.Range("F1")
For i = 2 To lastRow
If InStr(1, Range("A" & i), strCrit) <> 0 Then
j = j + 1
Range("C" & j + 1 & ":C" & j + 1) = Range("A" & i & ":A" & i).Value
End If
Next i
End Sub