Microsoft 365 Création fichier texte

[Mike89]

Bonjour à tous,

Je cherche à créer un fichier texte selon l'intitulé de la colonne A et donc y intégrer toutes les lignes contenant le même intitulé. La macro fonctionne cependant il y a un problème lors de la création du dernier fichier.

Ci-dessous le code :

Sub CréationTXT()
Dim dLig As Long, Lig As Long, LigSu As Long
Dim NumFic As Long, sDos As String
' Dossier de destination
sDos = ThisWorkbook.Path & "\"
' Numéro de fichier
NumFic = FreeFile
With ThisWorkbook.Sheets(1)
' Dernière ligne remplie de la colonne
dLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
i = 1
LigSu = Lig + 1
For Lig = i To dLig
' Créer le fichier
Open sDos & .Range("A" & Lig) & ".txt" For Output As #NumFic
Do While Range("A" & LigSu) = Range("A" & Lig)
' Inscrire la valeur dedans
Print #NumFic, .Range("B" & Lig).Value & vbNewLine;
Lig = Lig + 1
LigSu = Lig + 1
Loop
Print #NumFic, .Range("B" & Lig).Value
' Fermer le fichier
Close #NumFic
Next Lig
End With
End Sub

Merci d'avance pour votre aide

cdlt,
Mike89

 

[patricktoulon]

re
@job75 oui tu a raison je me suis perdu là
en fait c'est plus simple

Sub CreerTXT()
    Dim chemin$, tablo, ub&, i&, x%, nomfich$, j&, Tour_i&, Tour_J
    chemin = ThisWorkbook.Path & "\"
    tablo = [A1].CurrentRegion.Resize(, 2)
    ub = UBound(tablo)
    For i = 1 To ub
        Tour_i = Tour_i + 1
        If tablo(i, 2) <> "" Then
            x = FreeFile
            nomfich = tablo(i, 1)
            Open chemin & nomfich & ".txt" For Output As #x    'ouverture en écriture séquentielle
            For j = i To ub
                Tour_J = Tour_J + 1
                If tablo(j, 1) = nomfich Then
                    Print #x, tablo(j, 2)    'écriture
                    tablo(j, 2) = ""    'repèrage par effacement
                    i = i + 1
                End If
            Next j
            Close #x
        End If
    Next i
    texte = Tour_i & " tours de boucle sur i" & vbCrLf
    texte = texte & Tour_J & " tours de boucle sur J"
    MsgBox texte

End Sub