XL 2019 Macro - Combiner fichiers Bloc-Note

[Bastien43]

Bonjour,

Je cherche à combiner en créant une macro (bouton) des fichiers texte bloc-note. 3 fichiers bloc-note dans 3 dossiers différents, en gardant juste cette en-tête et en supprimant les autres en-tête :

;Calage en Pression
;Localisation Heure Valeur
;--------------------------

Quelqu'un a -t-il une solution svp ?

Je vous remercie
Cordialement
Bastien

 

[job75]

Bonjour à tous,

Téléchargez le fichier .xlsm et les 3 dossiers zippés dans le même répertoire (le bureau).

La macro affectée au bouton :

Sub Regrouper_TXT()
Dim chemin$, n As Byte, fichier$, nn&, x%, texte$, a$(), i&
chemin = ThisWorkbook.Path & "\"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        While Not EOF(1) 'EndOfFile : fin du fichier
            Line Input #x, texte 'récupère la ligne
            ReDim Preserve a(i) 'tableau VBA, base 0
            a(i) = texte
            i = i + 1
        Wend
        Close #x
        fichier = Dir 'fichier suivant
    Wend
Next
'---restitution---
x = FreeFile
Open chemin & "Fichier_Pression_Final.txt" For Output As #x 'accès en écriture
Print #x, Join(a, vbLf)
Close #x
MsgBox nn & " fichiers textes ont été regroupés dans 'Fichier_Pression_Final.txt'..."
End Sub

A+

 

[Bastien43]

Bonjour à tous,

Téléchargez le fichier .xlsm et les 3 dossiers zippés dans le même répertoire (le bureau).

La macro affectée au bouton :

Sub Regrouper_TXT()
Dim chemin$, n As Byte, fichier$, nn&, x%, texte$, a$(), i&
chemin = ThisWorkbook.Path & "\"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        While Not EOF(1) 'EndOfFile : fin du fichier
            Line Input #x, texte 'récupère la ligne
            ReDim Preserve a(i) 'tableau VBA, base 0
            a(i) = texte
            i = i + 1
        Wend
        Close #x
        fichier = Dir 'fichier suivant
    Wend
Next
'---restitution---
x = FreeFile
Open chemin & "Fichier_Pression_Final.txt" For Output As #x 'accès en écriture
Print #x, Join(a, vbLf)
Close #x
MsgBox nn & " fichiers textes ont été regroupés dans 'Fichier_Pression_Final.txt'..."
End Sub

A+

Bonsoir @job75 ,

Encore merci pour la macro et pour votre aide. Vous m'avez permis d'avancer et de gagner énormément de temps.

Bonne soirée
Bastien

 

[job75]

Bonjour Bastien43, le forum,

Si l'on ne veut pas copier à chaque fois les 3 lignes de titres utiliser :

Sub Regrouper_TXT()
Dim chemin$, i&, a$(), n As Byte, fichier$, nn&, x%, texte$
chemin = ThisWorkbook.Path & "\"
i = 3
ReDim a(i) 'tableau VBA, base 0
a(0) = ";Calage en Pression"
a(1) = ";Localisation Heure Valeur"
a(2) = ";--------------------------"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        Line Input #x, texte: Line Input #x, texte: Line Input #x, texte 'saute 3 lignes
        While Not EOF(1) 'EndOfFile : fin du fichier
            Line Input #x, texte 'récupère la ligne
            ReDim Preserve a(i)
            a(i) = texte
            i = i + 1
        Wend
        Close #x
        fichier = Dir 'fichier suivant
    Wend
Next
'---restitution---
x = FreeFile
Open chemin & "Fichier_Pression_Final.txt" For Output As #x 'accès en écriture
Print #x, Join(a, vbLf)
Close #x
MsgBox nn & " fichiers textes ont été regroupés dans 'Fichier_Pression_Final.txt'..."
End Sub

Voyez le fichier (2) zippé joint.

A+

 

[Bastien43]

Bonjour,

Merci pour votre temps. Cela fonctionne super bien.

Bonne journée
Cordialement
Bastien