Modification Macro fusion fichier csv

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
 

Discussions similaires

  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
704
Réponses
4
Affichages
419

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.