Conversion auto fichier texte en Excel

    Workbooks.OpenText Filename:="C:\Users\toto\Documents\aa.txt", Origin:= _        
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array _
        (3, 1)), TrailingMinusNumbers:=True
    ActiveWorkbook.SaveAs Filename:="C:\Users\toto\Documents\aa.xls", FileFormat _
        :=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        False, CreateBackup:=False

Sub TraiteFicTXT()
Dim DossSource As String, DossDest As String, NomFic As String, Wkb As Workbook
    DossSource = "C:\Users\toto\Documents\" 'dossier contenant les fichiers txt
    DossDest = "C:\Users\toto\Documents\" 'dossier où enregistrer les xls
    NomFic = Dir(DossSource & "*.txt")
    Do Until NomFic = ""
        Workbooks.OpenText Filename:=DossSource & NomFic, Origin:= _
            xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False _
            , Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array _
            (3, 1)), TrailingMinusNumbers:=True
        Set Wkb = ActiveWorkbook
        Wkb.SaveAs Filename:=DossDest & Left(NomFic, InStrRev(NomFic, ".") - 1) & ".xls", FileFormat _
            :=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
            False, CreateBackup:=False
        Wkb.Close False
        NomFic = Dir
    Loop
End Sub