Option Explicit
Sub Transfert()
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Feuil2").Delete
ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Feuil2"
Sheets("Feuil1").Select
Range("B1", [B30000].End(xlUp)).Copy Sheets("Feuil2").Range("A1")
Application.DisplayAlerts = True
End Sub