Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Modification Macro fusion fichier csv

  • Initiateur de la discussion Initiateur de la discussion ze_mechant
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ze_mechant

XLDnaute Nouveau
Bonjour tout le monde,

J'aurais besoin d'aide pour la modification d'une macro (que j'ai récupéré sur un forum).
Cette macro permet de fusionner plusieurs fichiers .xls se trouvant dans un même dossier.
J'aurais besoin qu'elle fasse la même chose mais avec deux petites modifications:
1-Qu'elle fusionne des fichiers csv au lieu de fichier xls
2-Qu'elle insère une colonne dans chaque fichier à fusionner, dans laquelle serait inscrit le nom du fichier.

Le résultat voulu est que dans le fichier "récap" je retrouve tous les tableaux des fichiers sources (qui ont tous le même nombre de colonne, mais un nombre de ligne différente), avec une colonne en plus qui précisera pour chaque ligne le nom du fichier source.

Je sais que j'en demande beaucoup.. mais j'en ai vraiment besoin et tous mes essais ont échoué!
Par avance Merci!

Sub recap()

Set fso = CreateObject("Scripting.FileSystemObject")
Set repertoire = fso.GetFolder(ThisWorkbook.Path)
Set fichiers = repertoire.Files

Application.ScreenUpdating = False

For i% = 1 To ThisWorkbook.Sheets.Count
Sheets(i).Select
Range(Range("A65536").End(xlUp), Range("j2")).Rows.EntireRow.Delete
Next

For Each f In fichiers
NomComplet = fso.buildpath(repertoire, f.Name)
If NomComplet <> ThisWorkbook.FullName And fso.GetExtensionName(NomComplet) = "xls" Then
Workbooks.Open Filename:=NomComplet
For i% = 1 To Sheets.Count
Workbooks(fso.GetBaseName(NomComplet) & "." & fso.GetExtensionName(NomComplet)).Activate
Sheets(i).Select
Range(Range("A65536").End(xlUp), Range("J2")).Copy
ThisWorkbook.Activate
Sheets(i).Select
Range("A65536").End(xlUp).Offset(2, 0).Range("A1").Select
ActiveSheet.Paste
Selection.Rows.Group
Next
Workbooks(fso.GetBaseName(NomComplet) & "." & fso.GetExtensionName(NomComplet)).Close False
End If
Next

Application.ScreenUpdating = True

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
478
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
862
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
653
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…