Générer des fichiers textes avec critères

Sub CreationFichiersTexte()
Dim rng As Range, r As Range, plgAnalyses As Range, a As Range
Dim f As Integer, first As Boolean, idx As Integer
Dim ligne As String
    'déterminer la plage des données
    With Sheets("Sheet1").Range("A1").CurrentRegion
        If .Rows.Count > 2 Then
            Set rng = .Offset(2).Resize(.Rows.Count - 2)
        Else
            MsgBox "aucune donnée à traiter n'a été trouvé!"
            Exit Sub
        End If
    End With
    
    'Pour chaque ligne dans la plage des données
    For Each r In rng.Rows
        'Si la première cellule commence par une Lette, un point,4 chiffres, un point
        If r.Cells(1, 1) Like "[A-Z].####.#*" Then
            'déterminer s'il existe des analyse à enregistrer
            On Error Resume Next
                Set plgAnalyses = r.Offset(, 3).Resize(, r.Columns.Count - 3).SpecialCells(xlCellTypeConstants)
            On Error GoTo 0
            If Not plgAnalyses Is Nothing Then
                'ouvrir un fichier
                f = FreeFile()
                idx = idx + 1
                Open ThisWorkbook.Path & "\PHARMA_" & Format(Now, "yyyymmdd_hhmmss") & "_" & idx & ".txt" For Append As #f
                Print #f, "LABORATOIRE;"
                Print #f, r.Cells(1, 1)
                first = True 'il faut ecrire PHARMA
                For Each a In plgAnalyses.Cells
                    If a.Value <> "" Then
                        ligne = "ANALYSE " & a.Column - 3 & ";" & a.Text & ";"
                        If first Then ligne = "PHARMA;" & ligne
                        Print #f, ligne
                        first = False
                    End If
                Next
            End If
            Print #f, "END;"
            Close #f
        End If
    Next
End Sub

 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

ligne = "ANALYSE " & a.Column - 3 & ";" & a.Text & ";"

ligne = a.Parent.Cells(1, a.column) & ";" & a.Text & ";"