Sub Extraire()
Dim Fin As Long
Fin = [B65536].End(xlUp).Row
Application.ScreenUpdating = False
[A4].FormulaR1C1 = _
"=LEFT(RC[1],SUMPRODUCT(ISNUMBER(MID(RC[1],ROW(OFFSET( R1C1,,,LEN(RC[1]))),1)*1)*1))"
[A4].AutoFill Destination:=Range("A4:A" & Fin)
Range("B4").EntireColumn.Insert
[B4].FormulaR1C1 = "=TRIM(RIGHT(RC[1],LEN(RC[1])-LEN(RC[-1])))"
Range("B4").AutoFill Destination:=Range("B4:B" & Fin)
Range("A4:C" & Fin).Value = Range("A4:C" & Fin).Value
Columns("C:C").Delete
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub