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

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

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