Fusionner plusieurs fichiers en un seul

Le 06/11/2018 à 12:19

Bonjour,

J'exporte régulièrement des données dans des fichiers excel.

Ces fichiers ont tous le même format, 8 premières lignes pour le titre, 169 colonnes et entre 1000 et 30000 lignes.

Je sors 11 de ces fichiers à chaque fois et je copie colle les données dans un seul fichier, une même feuille.

Ces fichiers sont nommés Export_sites, Export_sites (1), Export_sites (2), Export_sites (3), jusqu'à Export_sites (10).

Je cherche donc comment automatiser la copie des données des 11 fichiers dans une seule feuille en supprimant à chaque fois les 8 premières lignes qui sont le titre.

Merci pour vos conseils.

32copie-de-export-sites-1.zip (7.19 Ko)
Le 06/11/2018 à 12:40

Salut Murgot,

J'ai exactement eu la même demande de mes collègues qui est aujourd'hui solutionné.

La problématique c'est pas le copier/coller en lui même qui se résout par un simple :

Workbooks(Title & ".xlsx").Activate
a = Range("A" & Rows.Count).End(xlUp).Row
Range("A9:AZ" & a).Copy
Workbooks("Fichier destinataire.xlsm").Activate
Range("A1").Select
ActiveSheet.Paste

Pour traiter ta demande, il serait mieux de nous dire comment est-ce que tu va chercher tes 11 fichiers qui sont à copier puis coller sur une même feuille :

Est-ce que ces onze fichiers sont ouverts ?

Est-ce que tu liste le chemin de ces onze fichiers sur ton excel ?

Est-ce qu'ils sont tous dans le même dossier ?

Dans l'attente de ton retour

Le 06/11/2018 à 12:47

En fait je les télécharge d'une base de donnée sur internet.

Ils arrivent par défaut dans mon répertoire téléchargement et ont tous le nom Export_sites.xls que je ne peux pas modifier.

Le premier que je télécharge a le nom de fichier : Export_sites.xls, les suivants Export_sites (1).xls, puis Export_sites (2).xls, jusqu'à 10.

Ils sont ouvert si je les ouvre.

Je n'ai pas besoin de lister les 11 fichiers dans mon fichier cible, en fait je les groupe justement pour n'avoir qu'à ouvrir un seul fichier selon mes recherches. Les 10 autres je les supprime ou je les archives.

Oui ils sont tous dans le dossier téléchargement, ou ailleurs si je les déplace.

Ils n'ont tous qu'une seule feuille qui s'appelle "sites".

Le 06/11/2018 à 13:53

Bonjour tout le monde,

Tu peux essayer ce code en l'adaptant à ta situation. (j'ai retravaillé le code de Juice)

Sub macro1()
Set nw = Workbooks.Add
For i = 0 To 10

    chemin = "D:nana\nanana\"

    If i = 0 Then
        nom_fichier = "Export_sites.xls"
    Else: nom_fichier = "Export_sites(" & i & ").xls"

    End If

    Set fichier = Workbooks.Open(chemin & nom_fichier)

    a = fichier.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    fichier.Sheets(1).Range("A9:AZ" & a).Copy
    nw.Sheets(1).Activate
    b = nw.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    nw.Sheets(1).Range("A" & b).Select
    ActiveSheet.Paste

    fichier.Close SaveChanges:=False
Next

End Sub
Le 06/11/2018 à 14:36

Re- Murgot,

Salutation Mus!

@Murgot :

En fait je les télécharge d'une base de donnée sur internet.

Ils arrivent par défaut dans mon répertoire téléchargement et ont tous le nom Export_sites.xls que je ne peux pas modifier.

Donc il vienne tous se mettre dans le même dossier.

Avec le code ci-dessous (fichier joint également), tu dois juste modifier le nom du chemin comme indiquée en vert :

Option Explicit
Public Chemin As String
Sub ListFile()
'#Liste la totalité des chemin et fichier présent dans le dossier indiqué
Dim File As String
Dim a As Long
'Ici tu remplace par le chemin menant à tes onze fichiers
Chemin = "C:\REPERTOIRE\Chemin...\"
File = Dir(Chemin)
a = 2
Do While File <> ""
    Cells(a, 1) = Chemin & File
    Cells(a, 2) = File
    File = Dir
    a = a + 1
Loop
Call OpenFileAndCopyPaste
End Sub
Sub OpenFileAndCopyPaste()
'#Ici les fichiers s'ouvrent les uns après les autres et on copie / colle les données
Dim Way As String, File As String, Title As String
Dim a As Long, x As Long, y As Long
Dim Classeur As Workbook
x = Range("A" & Rows.Count).End(xlUp).Row
Title = "Regroupement fichier"
Application.DisplayAlerts = False
For y = 2 To x
    Way = Cells(y, 1)
    File = Cells(y, 2)
    Workbooks.Open Filename:="" & Way & ""
    a = Range("A" & Rows.Count).End(xlUp).Row
    If y = 2 Then
        Set Classeur = Application.Workbooks.Add
        With Classeur
            .SaveAs Chemin & Title
        End With
        Workbooks(File).Activate
        Range("A1:AZ" & a).Copy
    Else
        Range("A9:AZ" & a).Copy
    End If
    Workbooks(Title & ".xlsx").Activate
    a = Range("A" & Rows.Count).End(xlUp).Row + 1
    Cells(a, 1).Select
    ActiveSheet.Paste
    Workbooks(File).Close savechanges:=False
    Workbooks("Pour Murgo.xlsm").Activate
Next
Application.DisplayAlerts = True
End Sub

Le code de Mus est vraiment adapter pour ta demande (par contre il te manque un "End If" dans ton code poto !)

Reste à dispo si il y a des questions

41pour-murgo.xlsm (16.40 Ko)
Le 06/11/2018 à 14:55

Bonjour Juice,

Je n'ai pas testé mon code, j'ai pas vu qu'il manquait le end if

Mercii

Le 06/11/2018 à 16:13

Merci,

J'ai téléchargé le fichier, mis les chemins mais quand je vais dans le menu macro, afficher, exécuter les macros, d'abord ListFile puis OpenFile&CopyPaste, il ne se passe rien du tout à chaque fois.

Voici le code avec ce que j'ai rajouté

Option Explicit
Public Chemin As String
Sub ListFile()
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (1).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (2).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (3).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (4).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (5).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (6).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (7).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (8).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (9).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (10).xls
'C:\Users\Stéphane\Downloads\exports a fusionner\Export_sites (11).xls

Dim File As String
Dim a As Long
'Ici tu remplace par le chemin menant à tes onze fichiers
Chemin = "C:\Users\Stéphane\Downloads\exports a fusionner"
File = Dir(Chemin)
a = 2
Do While File <> ""
    Cells(a, 1) = Chemin & File
    Cells(a, 2) = File
    File = Dir
    a = a + 1
Loop
Call OpenFileAndCopyPaste
End Sub
Sub OpenFileAndCopyPaste()
'#Ici les fichiers s'ouvrent les uns après les autres et on copie / colle les données
Dim Way As String, File As String, Title As String
Dim a As Long, x As Long, y As Long
Dim Classeur As Workbook
x = Range("A" & Rows.Count).End(xlUp).Row
Title = "Regroupement fichier"
Application.DisplayAlerts = False
For y = 2 To x
    Way = Cells(y, 1)
    File = Cells(y, 2)
    Workbooks.Open Filename:="" & Way & ""
    a = Range("A" & Rows.Count).End(xlUp).Row
    If y = 2 Then
        Set Classeur = Application.Workbooks.Add
        With Classeur
            .SaveAs Chemin & Title
        End With
        Workbooks(File).Activate
        Range("A1:AZ" & a).Copy
    Else
        Range("A9:AZ" & a).Copy
    End If
    Workbooks(Title & ".xlsx").Activate
    a = Range("A" & Rows.Count).End(xlUp).Row + 1
    Cells(a, 1).Select
    ActiveSheet.Paste
    Workbooks(File).Close SaveChanges:=False
    Workbooks("Pour Murgo.xlsm").Activate
Next
Application.DisplayAlerts = True
End Sub
Le 06/11/2018 à 16:17

Re Murgo-

A la ligne ci-dessous :

Chemin = "C:\Users\Stéphane\Downloads\exports a fusionner"

[...] Merci de rajouter "\" à la fin pour obtenir :

Chemin = "C:\Users\Stéphane\Downloads\exports a fusionner\"

[...] puis de réessayer et de revenir vers nous en cas de problème.

NB : Le fichier que je t'ai donné dois rester nommée "Pour Murgo.xlsm" ou alors (si tu a modifié le nom du fichier, tu doit modifier la ligne ci-dessous pour que les noms correspondent) :

Workbooks("Pour Murgo.xlsm").Activate

Restant à ta dispo

Rechercher des sujets similaires à "fusionner fichiers seul"