Menu
  1. Accueil
  2. Forum d'assistance informatique
  3. Bureautique
  4. Excel

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

Signaler
-
 Gabish -
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

Réponse 1 / 10
Messages postés
8128
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 juin 2020
 1 430
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

Merci
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65104 internautes nous ont dit merci ce mois-ci

Réponse 2 / 10

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 !
Signaler
Messages postés
16160
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
3 juillet 2020
 2 985
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
Réponse 3 / 10
Messages postés
8128
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 juin 2020
 1 430
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
Réponse 4 / 10

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
Réponse 5 / 10
Messages postés
8128
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 juin 2020
 1 430
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
Réponse 6 / 10

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.
Signaler
Messages postés
8128
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 juin 2020
 1 430
Non, ça devrait fonctionner.

Au lieu de F5,
essaies Execution / Executer Sub/Userform
Réponse 7 / 10
Messages postés
16160
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
3 juillet 2020
 2 985
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 ?

Réponse 8 / 10

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.
Réponse 9 / 10

Bonjour Michel,

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

Merci !
Signaler
Messages postés
8128
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
24 juin 2020
 1 430
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
Réponse 10 / 10

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

Merci beaucoup.
Posez votre question