couper des mots dans des cellules

Sub macro()
Range("A1:A" & [A65536].End(xlUp).Row).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 1))
With Range("C1")
    .FormulaR1C1 = "=RC[-2]&""\""&RC[-1]"
    .AutoFill Destination:=Feuil1.Range("C1:C" & Feuil1.[B65536].End(xlUp).Row)
    .Resize([B65536].End(xlUp).Row, 1).Value = .Resize([B65536].End(xlUp).Row, 1).Value
    .Offset(, -2).Resize([B65536].End(xlUp).Row, 2).Delete Shift:=xlToLeft
End With
End Sub