Créer fichiers txt + remplir avec contenus feuille Excel

Bonjour Le Forum,

J'utilise une macro pour lister le contenu (PDF) d'un répertoire sans l'extension en question : pas de soucis à ce niveau.

En revanche, je souhaiterai par la suite via une macro créer un fichier txt par ligne de ma feuille :

- le nom du fichier est en colonne A + ajouter extension ".txt"

- le contenu du fichier txt est en colonne B

- il faudrait également pouvoir déterminer le répertoire de sortie des txt crées.

Je joint un petit fichier exemple pour une meilleure compréhension.

Je vous remercie par avance de votre aide.

Bonjour,

J'ai trouvé un bout de code qui pourrait faire ce que je cherche mais j'ai besoin d'aide pour l'adapter à mon cas de figure.

Sub test()
    Dim numfich As Long, c As Range
    numfich = FreeFile
    Open "C:\TEST\" & [A1] & ".txt" For Output As #numfich
    For Each c In [A:A]
        Print #numfich, c.Value & vbCrLf;
        ' ou
        'Print #numfich, c.Text & vbCrLf;
        'si tu as des arrondis à l'affichage que tu désires conserver
        'par exemple 7.786 affiché 7.79 mais dans le fichier ça sera : "7.79"
    Next c
    Close #numfich

End Sub

Moi je cherche, a créer autant de fichier txt que de ligne dans ma feuille excel avec comme nom le contenu des cellules en A.

Et que dans chaque fichier txt crée , le contenu des cellules de B soit inscrit...

Cette macro ne crée qu'un seul fichier txt avec comme nom le contenu de la cellule A1 et insère à l'intérieur tout le contenu de la colonne A

Merci d'avance pour votre aide

J'avance petit à petit ...

J'ai réussi à créer mes différents fichiers TXT selon le contenu de ma colonne A ( un fichier txt par ligne de la colonne A) en utilisant le code suivant :

Sub CreationTXT()

Dim sExportFolder, sFN
Dim rArticleName As Range
Dim rDisclaimer As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

sExportFolder = "C:\TAB_AVG\"
Set oSh = Feuil1

Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rArticleName In oSh.UsedRange.Columns("A").Cells
       Set rDisclaimer = rArticleName.Offset(, 1)

       sFN = rArticleName.Value & ".txt"
       Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
       oTxt.Write rDisclaimer.Value
       oTxt.Close
Next
End Sub

En revanche, je sèche pour insérer le contenu de chaque cellule de la colonne B dans chaque fichier TXT correspondant ??

Si quelqu'un peut m'aider ? Merci d'avance.

Bonjour SamSam07

Voici le code souhaité

Inutile de passer par l'usine à gaz de Scripting.FileSystemObject

Sub CréationTXT()
  Dim dLig As Long, Lig 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
    For Lig = 1 To dLig
      ' Créer le fichier
      Open sDos & .Range("A" & Lig) & ".txt" For Output As #NumFic
      ' Inscrire la valeur dedans
      Print #NumFic, .Range("B" & Lig).Value;
      ' Fermer le fichier
      Close #NumFic
    Next Lig
  End With
End Sub

@+

Bonjour,

Sub test()
Dim MonRepertoire, Repertoire As FileDialog
Dim cel As Range

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)

    For Each cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Close #1
        Open MonRepertoire & "\" & cel.Value & ".txt" For Output As #1
        Print #1, cel.Offset(0, 1).Value
        Close #1
    Next

    MsgBox "Terminé !"

End Sub

Bonsoir BrunoM45, Steelson,

Un grand merci à vous 2. Les 2 codes fonctionnent parfaitement.

Un tout petit "bémol" pour le code de Steelson qui engendre un saut de ligne dans le fichier txt ...

Je vous remercie encore grandement pour vos retours et vous souhaite une très bonne soirée.