Sub EcrireTxt()
Dim Fs As Object, Source As Object, Dest as Object, Ligne as string
Dim i As Byte
Set Fs = CreateObject("Scripting.FileSystemObject")
Set Dest = Fs.CreateTextFile(".\blablalbal\Dest.txt", True)
Set Source = Fs.OpenTextFile(".\blablalbal\Source.txt",1,False,-2)
i = 0
Do
Ligne = Source.readLine
Dest.writeline Ligne
i=i+1
Loop until i = 4
For i = 2 to 201
Dest.writeline Application.transpose(application.transpose(Range("A" & i & ":Z" & i).value, ",")
next i
Ligne = Source.readLine
Do until Source.atendofstream
Ligne = Source.readLine
Dest.writeline Ligne
Loop
Dest.Close
Source.Close
set Dest = nothing
Set source = nothing
Set fs = nothing
End Sub