VBA excel .csv en .txt

Sub test()

Dim Adr As String
Dim Chemin As String
Dim NomFichier As String
Dim NomFichierCsv As String
Dim NomFichierTxt As String

NomFichier = "MonClasseur.xls"
Workbooks(NomFichier).Activate
Chemin = ActiveWorkbook.Path & "\"
ActiveWorkbook.Save   'par sécurité

NomFichierCsv = Mid(NomFichier, 1, Len(NomFichier) - 3) & "csv"
NomFichierTxt = Mid(NomFichier, 1, Len(NomFichier) - 3) & "txt"
Adr = ActiveSheet.Rows(1).Resize(, ActiveSheet.UsedRange.Columns.Count + 1).Address
'Inserer une ligne et une colonne vierges, et des titres bidons
ActiveSheet.Rows(1).Insert
ActiveSheet.Columns(1).Insert
ActiveSheet.Range(Adr).Formula = "X"
'Enregistrer au format CSV point-virgule et fermer
ActiveWorkbook.SaveAs Filename:=Chemin & NomFichierCsv, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
Workbooks(NomFichierCsv).Saved = True
Workbooks(NomFichierCsv).Close
'Ouvrir (au format text)
Workbooks.Open Filename:=Chemin & NomFichierCsv
'Supprimer le 1° ligne bidon
ActiveSheet.Rows(1).Delete
'Enregistrer au format text et fermer
ActiveWorkbook.SaveAs Filename:=Chemin & NomFichierTxt, FileFormat:=xlCurrentPlatformText, CreateBackup:=False
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

'Ré-ouvrir le fichier xls initial
Workbooks.Open Filename:=Chemin & NomFichier, UpdateLinks:=xlUpdateLinksAlways

End Sub