Sub Transfert()
Dim tablo1, i&, tablo2(), n&
tablo1 = Sheets("Feuil1").Range("A1:B" & Sheets("Feuil1").[A65536].End(xlUp).Row)
For i = 1 To UBound(tablo1)
If tablo1(i, 2) Like "*BDC*" Then
ReDim Preserve tablo2(1, n)
tablo2(0, n) = tablo1(i, 1)
tablo2(1, n) = tablo1(i, 2)
n = n + 1
End If
Next
If n Then
Sheets("Feuil2").[A2:B65536].ClearContents
Sheets("Feuil2").[A2].Resize(n, 2) = Application.Transpose(tablo2)
End If
End Sub