Ouverture, modification et enregistrement

Sub Import()
    Workbooks.OpenText Filename:="C:\temp\test.txt", Origin:=xlMSDOS, StartRow _
        :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=True, Other:=False, FieldInfo:=Array(Array(1, 9), Array(2, 1), Array _
        (3, 1), Array(4, 1)), TrailingMinusNumbers:=True
    ActiveWorkbook.SaveAs Filename:="C:\temp\test.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub

Sub test()
Dim DossSource as String, DossDest as String, NomFic as String, FSO, Fic, Fic2, Ligne as String
    DossSource = "C:\temp\aaa\"
    DossDest = "C:\temp\bbb\"
    NomFic = Dir(DossSource & "*.xyz")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Do Until NomFic = ""
        Set Fic = FSO.OpenTextFile(DossSource & NomFic, 1, False, -2)
        Set Fic2 = FSO.CreateTextFile(DossDest & NomFic, True)
        Do Until Fic.AtEndOfStream
            Ligne = Fic.ReadLine
            Fic2.WriteLine Right(Ligne, Len(Ligne) - InStr(1, Ligne, " "))
        Loop
        Fic.Close
        Fic2.Close
        NomFic = Dir
    Loop
    Set Fic = Nothing
    Set Fic2 = Nothing
    Set FSO = Nothing
End Sub

Dim DossSource, DossDest, NomFic, FSO, Fic, Fic2, Ligne, Doss, F
    DossSource = "C:\temp\aaa\"
    DossDest = "C:\temp\bbb\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Doss = FSO.GetFolder(DossSource)
    For Each F In Doss.Files
    If LCase(Right(F.Name, 4)) = ".xyz" Then
            Set Fic = FSO.OpenTextFile(DossSource & F.Name, 1, False, -2)
            Set Fic2 = FSO.CreateTextFile(DossDest & F.Name, True)
            Do Until Fic.AtEndOfStream
                Ligne = Fic.ReadLine
                Fic2.WriteLine Right(Ligne, Len(Ligne) - InStr(1, Ligne, " "))
            Loop
            Fic.Close
            Fic2.Close
    End If
    Next
    Set Fic = Nothing
    Set Fic2 = Nothing
    Set FSO = Nothing

Sub ConvXYZ()
Dim DossSource As String, DossDest As String, NomFic As String, FSO, Fic, Fic2, Ligne As String
Dim Tablo() As String, i As Long, j As Long
    DossSource = "C:\temp\aaa\"
    DossDest = "C:\temp\bbb\"
    ReDim Tablo(1 To 1)
    NomFic = Dir(DossSource & "*.xyz")
    Do Until NomFic = ""
        Tablo(UBound(Tablo)) = NomFic
        NomFic = Dir
        ReDim Preserve Tablo(1 To UBound(Tablo) + 1)
    Loop
    If UBound(Tablo) > 1 Then ReDim Preserve Tablo(1 To UBound(Tablo) - 1)
    Call tri(Tablo, 1, UBound(Tablo))
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For i = LBound(Tablo) To UBound(Tablo)
        j = i Mod 95
        Set Fic = FSO.OpenTextFile(DossSource & Tablo(i), 1, False, -2)
        If j = 1 Then Set Fic2 = FSO.CreateTextFile(DossDest & "Fichier" & Format((i \ 95) + 1, "00") & ".xyz", True)
        Do Until Fic.AtEndOfStream
            Ligne = Fic.ReadLine
            Fic2.WriteLine Right(Ligne, Len(Ligne) - InStr(1, Ligne, " "))
        Loop
        Fic.Close
        If j = 0 Or i = UBound(Tablo) Then Fic2.Close
    Next i
    Set Fic = Nothing
    Set Fic2 = Nothing
    Set FSO = Nothing
End Sub

Sub tri(a, gauc, droi) ' Quick sort JB http://boisgontierjacques.free.fr/
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call tri(a, g, droi)
   If gauc < d Then Call tri(a, gauc, d)
End Sub