Regrouper plusieurs fichiers excel en un seul [Résolu/Fermé]

- - Dernière réponse :  Gabish - 18 avril 2019 à 20:14
Bonjour,

J'ai une centaine de fichiers excel constitué d'uns seule colonne de données.
Et je souhaiterais les regrouper en un seul fichier excel, sans passer par la fonction copier/coller.

Que faire ?
Merci de votre aide.



Afficher la suite 

10 réponses

Meilleure réponse
Messages postés
7828
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
11 octobre 2019
1215
3
Merci
Bonjour,

Sans passer par copier/coller c'est une difficulté supplémentaire inutile,
donc voici une macro avec des copier/ coller (adapter le nom du répertoire) :
Public Sub Regrouper_Fichiers()
' regroupe dans les colonnes de la feuille 1 d'un fichier,
' la colonne A de chaque fichier excel d'un répertoire.
'
Dim fso As Object               'Système de fichiers
Dim rep As Object               'Répertoire
Dim cfr As Object               'Collection de fichiers du répertoire
Dim fic As Object               'Fichier (élément de la collection cfr)
Dim wbk As Workbook             'Classeur
Dim res As Workbook             'Classeur resultat
Dim rng As Range                'Plage de cellules
Dim dst As Range                'Cellule de destination
Dim pth As String               'Chemin du répertoire

' Définir le répertoire à lire
pth = "D:\TEMP"
' Créer le fichier résultat
Set res = Workbooks.Add(xlWBATWorksheet)
Set dst = res.Worksheets(1).Range("A1")
' Lecture du répertoire
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(pth)
Set cfr = rep.Files
' Contrôler chaque fichier du répertoire
For Each fic In cfr
  ' - Vérifier s'il s'agit d'un fichier Excel...
  If StrComp(fso.GetExtensionName(fic.Name), "xlsx", vbTextCompare) = 0 Then
    ' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
    Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
    ' Placer le nom du fichier en titre de colonne résultat
    dst.Value = fic.Name
    ' Copier la colonne en dessous
    Set rng = wbk.Worksheets(1).UsedRange.Columns(1)
    rng.Copy dst.Offset(1)
    ' Fermer le fichier sans le modifier
    wbk.Close False
    ' Destination sur colonne suivante
    Set dst = dst.Offset(0, 1)
  End If
Next fic

End Sub
Si tes fichiers sont au format xls au lieu de xlsx, corriges la ligne 27

Dire « Merci » 3

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 62603 internautes nous ont dit merci ce mois-ci

1
Merci
Re-bonjour Patrice,

Avec F5, la Macro a fonctionné.
Par contre, j'ai obtenu un nouveau fichier excel avec plusieurs colonnes, correspondant aux différents fichiers excel que je voulais regrouper.

Je me suis peut être mal exprimée.
Voilà j'ai une centaine de fichiers excel, avec une seule colonne contenant les adresse mail de mes clients :Fichier-01, Fichier-02, ..., Fichier-99.

Dans chaque fichier, il n'y a qu'une seule colonne et environ entre 50 et 200 lignes de données.
Ce que je souhaiterais, c'est regrouper en un seul fichier tous ces 99 fichiers.
Le fichier final doit comporter une seule colonne avec toutes les données de chaque fichier, à savoir environ 10 000 à 12 000 lignes.

Or avec la Macro présente, j'ai obtenu un fichier avec 99 colonnes, et les données de chaque fichier en ligne.

Voila, j'attends votre réponse.
Merci !
michel_m
Messages postés
15930
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
11 octobre 2019
2809 -
Re,
Excuse moi ,Solene d'avoir essayé de t'aider en te proposant une autre méthode.
mais c'est promis, je ne récidiverai pas
Messages postés
7828
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
11 octobre 2019
1215
1
Merci
Re,

Voici un code pour tout regrouper dans une seule colonne :
Public Sub Regrouper_Fichiers()
' regroupe dans les colonnes A de chaque fichier excel d'un répertoirede
' dans la colonne A de la feuille 1 d'un nouveau fichier.
'
Dim fso As Object               'Système de fichiers
Dim rep As Object               'Répertoire
Dim cfr As Object               'Collection de fichiers du répertoire
Dim fic As Object               'Fichier (élément de la collection cfr)
Dim wbk As Workbook             'Classeur
Dim res As Workbook             'Classeur resultat
Dim rng As Range                'Plage de cellules
Dim dst As Range                'Cellule de destination
Dim pth As String               'Chemin du répertoire

' Définir le répertoire à lire
pth = "C:\DOC\ADRESS\"
' Créer le fichier résultat
Set res = Workbooks.Add(xlWBATWorksheet)
Set dst = res.Worksheets(1).Range("A1")
' Lecture du répertoire
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(pth)
Set cfr = rep.Files
' Contrôler chaque fichier du répertoire
For Each fic In cfr
  ' - Vérifier s'il s'agit d'un fichier Excel...
  If StrComp(fso.GetExtensionName(fic.Name), "xlsx", vbTextCompare) = 0 Then
    ' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
    Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
    ' Copier la colonne en dessous
    Set rng = wbk.Worksheets(1).UsedRange.Columns(1)
    rng.Copy dst
    ' Fermer le fichier sans le modifier
    wbk.Close False
    ' Destination suivante
    With res.Worksheets(1)
      Set dst = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
    End With
  End If
Next fic

End Sub


0
Merci
Bonjour,

Je vous remercie pour votre réponse.

Par contre je n'ai jamais utilisé de Macro dans Excel.
Alors je ne sais pas où je dois inclure ce Macro, ni quel paramètre de votre Macro je dois modifier.
Voila, j'ai des fichiers dans un répertoire : C:\DOC\ADRESS\
Les fichiers sont Fichier-1.xls, Fichier-2.xls, ...etc
Dans chaque fichier il y une colonne sans titre que avec l'adresse mail.
Comment je dois faire pour les regrouper en un seul fichier excel ?

Désolée pour mon ignorance, et merci par avance pour votre aide

suis vraiment une n
Messages postés
7828
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
11 octobre 2019
1215
0
Merci
Re,

Ouvres Excel (avec un nouveau fichier vierge)
Clic droit sur l'onglet de la feuille 1 / Visualiser le code => ça ouvre une fenêtre Visual Basic
Insertion / Module

Sélectionnes la macro ci-dessus (ligne 1 à 42) / Copier
Dans la fenêtre Visual Basic / Coller
Dans le code (ligne 16) remplaces :
"D:\TEMP"
par
"C:\DOC\ADRESS\"

Appuies sur F5

Cordialement
Patrice
0
Merci
Bonjour Patrice,

Encore désolée de vous déranger, j'ai ouvert un nouveau fichier, et j'ai copié la macro dans la fenêtre Visual Basic, et j'ai bien remplacé le chemin par c:\doc\adress

Quand j'appuie sur F5, il ne se passe rien.
Je dois sauvegarder quelque chose, ou enregistrer ?

Merci de votre aide.
Patrice33740
Messages postés
7828
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
11 octobre 2019
1215 -
Non, ça devrait fonctionner.

Au lieu de F5,
essaies Execution / Executer Sub/Userform
Messages postés
15930
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
11 octobre 2019
2809
0
Merci
Bonjour,

Il y a une autre méthode sans ouvrir les fichiers mais il faut dire quelle est ta version Excel: <2007 ou >=2007 ?

Combien de lignes (environ) dans tes fichiers source ?

0
Merci
Bonjour Patrice 33740,

C'est topissime, ça marche !!
Un grand merci à vous.
Si vous saviez le temps que vous me faîtes gagner !

Merci infiniment.
0
Merci
Bonjour Michel,

Je vous remercie en tous les cas d'avoir voulu m'aider.
J'ai trouvé ma réponse.

Merci !
Patrice33740
Messages postés
7828
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
11 octobre 2019
1215 -
De rien, au plaisir de te relire sur le Forum.

Voici un excellent cours VBA gratuit pour débutant (et plus si affinités) :
ftp://ftp-developpez.com/bidou/Cours/VBA/formationVBA.pdf

Cordialement,
Patrice
0
Merci
Bonjour,
Merci les gars.
Macro trop top. J'ai meme essaye de recopier 2 colonnes et xa marche.

Merci beaucoup.
Commenter la réponse de Gabish