Sub FichierTexte()
Dim Pass As Boolean
Dim Chemin As String, MonCode As String, Nom As String, NomFic As String
Dim Derl As Long, DerCol As Long
Dim num As Integer
Chemin = "C:\TEMP\"
With Worksheets("Sheet1")
Derl = .Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To Derl
Pass = False
MonCode = Left(.Cells(i, 1).Value, 4)
If MonCode = "A.20" Then
DerCol = .Cells(i, Cells.Columns.Count).End(xlToLeft).Column
num = FreeFile
Nom = "PHARMA_" & Format(Now(), "ddmmyy_hhmmss") & ".txt"
NomFic = Chemin & Nom
Open "C:\TEMP\" & Nom For Output As #num
Print #num, "LABORATOIRE;"
Print #num, .Cells(i, 1).Value & ";"
For j = 4 To DerCol
If .Cells(i, j).Value <> "" Then
If Pass = False Then
Print #num, "PHARMA;" & .Cells(1, j).Value & ";" & .Cells(i, j).Value&; ";"
Pass = True
Else
Print #num, .Cells(1, j).Value & ";" & .Cells(i, j).Value&; ";"
End If
End If
Next j
Print #num, "END;"
Close #num
End If
Application.Wait Time + TimeSerial(0, 0, 1) 'faire une pause sinon les fichier porte le meme nom et "s'écrasent "
Next
End With
End Sub