XL 2019 Macro - Combiner fichiers Bloc-Note

Bastien43

XLDnaute Occasionnel
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
 

Pièces jointes

  • Calage_pression_Fluks.txt
    2.3 KB · Affichages: 17
  • Calage_pression_hauteur_niveau_reservoirs.txt
    445 bytes · Affichages: 9
  • Calage_pression_Terrain.txt
    1.4 KB · Affichages: 7
Solution
Bonjour Bastien43, le forum,

Si l'on ne veut pas copier à chaque fois les 3 lignes de titres utiliser :
VB:
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...

Bastien43

XLDnaute Occasionnel
Bonsoir

J'ai tenté mais toujours bloqué.

Voici une macro possible ?

VB:
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

Quelqu'un a -t-il une idée ? ici je ne supprime pas non plus les en-tête des blocs notes

Merci
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Puisque vous avez excel 2019 voici une proposition par requête Power Query.
Dans la feuille 'Chemin fichier', en A1 (nommée 'Chemin') vous avez une fonction qui devrait retourner le nom du répertoire du fichier, dont se sert la requête pour aller chercher vos fichiers. Avant de rafraîchir la requête, vérifier qu'il est correcte. Sinon modifier le dans la cellule.

J'ai fait la requête de transformation en fonction de ce que comprenais de votre demande. Nous pouvons améliorer, ajouter, modifier, transformer comme vous désirez ou à peu près.

Le zip contient le fichier excel plus 3 dossiers, avec chacun un de vos fichiers
décompresser, ouvrez le fichier excel.

Cordialement
 

Pièces jointes

  • Bastien43.zip
    30.4 KB · Affichages: 7

Bastien43

XLDnaute Occasionnel
Bonsoir,

Cela semble fonctionner merci

Cependant cette étape est une partie de tout un fichier qui contient des macros. Est-il possible de créer une macro ?

merci pour votre aide
Bonjour,

Je viens de télécharger à nouveau le dossier. Cependant cette fois, j'ai cette erreur lors de l'actualisation : @Roblochon

DataSource.NotFound : File or Folder : Désolé... Nous ne trouvons pas le dossier 'D:\Documents\Excel\XLD\nautes\Calage_pression_*'.
Détails :
D:\Documents\Excel\XLD\nautes

Comment faire fonctionner la cellule chemin d'accès de la 2e feuille sans aller modifier dans l'éditeur ?

Merci
 
Dernière édition:

Bastien43

XLDnaute Occasionnel
Bonsoir,

Je relance le sujet.

Quelqu'un a-t-il une idée svp avec une macro dans l'idéal ?

Je cherche à combiner 3 fichiers texte contenus dans 3 dossiers avec une macro lancée depuis un fichier Excel.

Je joins les données en pièces jointes.

Je vous remercie
Cordialement
Bastien
 

Pièces jointes

  • Données.zip
    1.5 KB · Affichages: 4

Bastien43

XLDnaute Occasionnel
Bonjour, j'ai peut-être ceci en solution mais j'ai une erreur 55 "fichier déjà ouvert" sur Open. Quel est le problème ?

VB:
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
 

Bastien43

XLDnaute Occasionnel
Bonjour, merci pour la réponse, j'avais aussi vu cette discussion mais je n'arrive pas à adapter le code, je souhaite enregistrer en texte au final et en passant par le csv, tout semble décallée, ...
Bref pas facile
je cherche encore
merci pour votre aide
 
Dernière édition:

Bastien43

XLDnaute Occasionnel
Merci
j'avais trop déformé le code.
Bon j'arrive à assembler mais je ne veux pas de la colonne E. Comment la supprimer ?
et comment enregistrer en fichier .txt svp et donc lancer la macro depuis un fichier excel externe ?
 

Pièces jointes

  • Capture.PNG
    Capture.PNG
    65.5 KB · Affichages: 17
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 902
Membres
101 834
dernier inscrit
Jeremy06510