Macro - Combiner fichiers Bloc-Note

Bonjour,

Je cherche à combiner en créant une macro (bouton dans excel) 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 ?

J'ai une piste mais cela ne fonctionne pas :

Sub compil_texte()

    Dim fichier_final, nomfichier, x%, x2, chemin
    Dim CheminDossier$, dossier, i As Byte, chemintxt$, nomfich$, o As Boolean, NbFic As Integer

CheminDossier = ThisWorkbook.Path & "\" 'dossier à adapter
fichier_final = CheminDossier & "Fichier_Pression_Final.txt"

x = FreeFile

Open fichier_final For Output As #x

Print #x, ";Calage en Pression - Fichier Final"
Print #x, ";Localisation Heure Valeur"
Print #x, ";--------------------------"

Application.ScreenUpdating = False

dossier = Array("dossier1", "dossier2", "dossier3") 'noms des dossiers
j = 0

For i = 0 To UBound(dossier)

  chemintxt = CheminDossier & dossier(i) & "\"
  nomfich = Dir(chemintxt & "*.txt*") '1er fichier du dossier

        Do
            x = FreeFile
            Open nomfich For Input As #x
            laChaine = Input(LOF(x), #x)
            Close #x
            x2 = FreeFile
            Open fichier_final For Append As #x2
            Print #x, laChaine & vbCrLf ' si vous; voulez; pas une ligne vide entre chaque fichier; supprimer le  "& vbcrlf"
            Close #x
            j = j + 1
            fichier = Dir
        Loop Until fichier = ""

    nomfich = Dir 'fichier suivant du dossier

Next

MsgBox (j & " Fichiers assemblés !")

End Sub

Je vous remercie
Cordialement
Bastien

Bonjour Bastien43,

Je vois le mot réservé "Append" dans le code que vous proposez. Cela signifie que vous voulez ajouter des lignes à des fichiers textes. Est-ce bien le but recherché ?
Je crois que le plus simple serait de ne pas chercher à recycler un code proche de ce que vous voulez faire, mais de décrire de la façon la plus simple, la plus claire et la plus complète possible ce que vous voulez faire exactement.

Bonsoir,

Merci pour votre réponse. Je suis un débutant. Je tente de créer une macro qui fasse ceci. Avez vous une solution svp ?

Append ne semble donc pas nécessaire.

Je vous remercie,

Cordialement

Bonjour,

Quelqu'un a-t-il un solution pour combiner 3 fichiers texte contenus dans 3 dossiers ? Je cherche une macro lancée depuis un fichier Excel

Merci

Sub ConcatText()

    Dim CheminDossier1$, CheminDossier2$, CheminDossier3$, chemin$, CheminDossier4$, x%

    If MsgBox("Lancer la fusion des fichiers texte ?", vbYesNo) = vbNo Then Exit Sub

    chemin = ThisWorkbook.Path & "\" 'dossier à adapter

    CheminDossier1 = chemin & "Dossier1\" & "Calage_pression_Fluks.txt"
    CheminDossier2 = chemin & "Dossier2\" & "Calage_pression_Terrain.txt"
    CheminDossier3 = chemin & "Dossier3\" & "Calage_pression_hauteur_niveau_reservoirs.txt"
    CheminDossier4 = chemin & "Calage_toutes_les_Pressions.txt"

    x = FreeFile
    Open CheminDossier4 For Output As #x 'création du fichier TXT
    Print #x, ";Calage en Pression"
    Print #x, ";Localisation Heure Valeur"
    Print #x, ";--------------------------"

    Application.ScreenUpdating = False

    Open CheminDossier1 For Input As #1
    Open CheminDossier2 For Append As #2
    Open CheminDossier3 For Append As #3
    Open CheminDossier4 For Append As #4

    While Not EOF(1)    'tant qu'on n'est pas en fin de fichier
    Input #1, texte     'on récupère le ligne en entier
    Print #4, texte     'on la copie dans le fichier sauvegarde
    Wend

    Close #1 'Je ne suis plus sur de la synthaxe peut etre Free ou FreeFile a la place de Close

    'Input #2, texte 'Ca lit déja la premiere ligne et on en fait rien...
    'La suivante lue sera la seconde

    While Not EOF(2)
    Input #2, texte
    Print #4, texte
    Wend

    Close #2

    While Not EOF(3)
    Input #3, texte
    Print #4, texte
    Wend

    Close #2

    Close #4

    MsgBox ("Fichiers textes assemblés !")

End Sub

Bonjour,

Bon j'ai résolu le probème avec Open mais il y d'autre problèmes... Quelqu'un a-t-il une idée svp ?

Rebonjour,

Autre approche trouvée mais comment supprimer la colonne E ? (voir imprim écran) et enregistrer en fichier en .txt ?

Merci pour votre aide

Option Explicit

Sub Consolider_CSV()
Dim chemin$, fichier$, ncol%, F As Worksheet, lig&, n&
chemin = ThisWorkbook.Path & Application.PathSeparator
fichier = Dir(chemin)
ncol = 4 'nombre de colonnes des fichiers CSV, à adapter
Set F = Feuil1 'CodeName, à adapter
lig = 1 '1ère ligne de destination
Application.ScreenUpdating = False
F.Rows(lig & ":" & F.Rows.Count).Clear 'RAZ
While fichier <> ""
    If Right(fichier, 4) = ".txt" Then
        n = n + 1
        Workbooks.OpenText chemin & fichier, Local:=True
        With Sheets(1).[A1].CurrentRegion.Resize(, ncol)
            If n = 1 Then .Rows(1).Copy F.Cells(lig, 1): F.Cells(lig, ncol + 1) = "Fichier TXT": lig = lig + 1
            If .Rows.Count > 1 Then
                .Rows(2).Resize(.Rows.Count - 1).Copy F.Cells(lig, 1)
                F.Cells(lig, ncol + 1).Resize(.Rows.Count - 1) = ActiveWorkbook.Name
                lig = lig + .Rows.Count - 1
            End If
        End With
        ActiveWorkbook.Close False
    End If
    fichier = Dir
Wend
F.Rows(1).Font.Bold = True 'gras
F.Columns.AutoFit 'ajustement largeurs
With F.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
If n Then MsgBox n & " fichier" & IIf(n > 1, "s", "") & " CSV consolidé" & IIf(n > 1, "s...", "...")
End Sub

Bonjour

Problème solutionné :

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