XL pour MAC Assembler plusieurs fichiers Excel dans un fichier / seul classeur

jnce84

XLDnaute Nouveau
Bonjour,

Je me permets de solliciter votre aide car je travaille sur des exportations de DATA via un site internet et pour chaque étude, j'extrais un fichier Excel. A la fin de mon étude, je me retrouve avec une vingtaine de fichiers que je dois ouvrir un par un pour pouvoir en constituer qu'un seul pour traiter ensuite mes DATA. Je perds un temps fou à ouvrir chaque fichier pour voir coller les datas dans un seul fichier / un seul classeur. Auriez-vous une solution pour par exemple sélectionner tous les fichiers dans mon dossier et faire un click droit "assembler" (oui je rêve mais ça serait tellement idéal )

Voici un exemple de 3 fichiers que je voudrais assembler en un seul (Fichier Assemblage)

Merci pour votre aide, ça me ferait gagner un temps fou pour chaque export.

Fichier assemblé
Source1
Source2
Source3
 

mdo100

XLDnaute Occasionnel
Bonjour le forum, jnce84,

A tester:
Tous les fichiers doivent-être dans le même dossier.
Conserver la première ligne des titres et faire un click gauche sur le bouton "Go"

Cordialement.
 

Pièces jointes

  • assemblage-keyword-tool-export.xlsm
    15.9 KB · Affichages: 26

job75

XLDnaute Barbatruc
Bonjour jnce84, bienvenue sur XLD, bonjour mdo100,

Téléchargez les fichiers joints dans le même dossier et sur le fichier .xlsm exécutez cette macro :
VB:
Sub Assembler()
Dim chemin$, fichier$, feuille$, ncol%, lig&, form$, h&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Keywords" 'nom des feuilles à copier, à adapter
ncol = 15 'nombre de colonnes, à adapter
lig = 2 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1 'CodeName à adapter
    .UsedRange.EntireRow.Offset(1).Delete 'RAZ
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
            h = 0
            On Error Resume Next
            h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'calcul sur colonne 1
            On Error GoTo 0
            If h > 1 Then
                With .Cells(lig, 1).Resize(h - 1, ncol)
                    .FormulaArray = "=" & form & "R2C1:R" & h & "C" & ncol 'formule de liaison matricielle
                    .Value = .Value 'supprime la formule
                    .Replace 0, "", xlWhole 'supprime les zéros
                End With
                lig = lig + h - 1
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Les copies se font par des formules de liaison, l'ouverture des fichiers n'est pas nécessaire.

A+
 

Pièces jointes

  • Assemblage(1).xlsm
    18.8 KB · Affichages: 14
  • Source1.xlsx
    7.2 KB · Affichages: 12
  • Source2.xlsx
    7.4 KB · Affichages: 12
  • Source3.xlsx
    11.4 KB · Affichages: 11

jnce84

XLDnaute Nouveau
Bonjour jnce84, bienvenue sur XLD, bonjour mdo100,

Téléchargez les fichiers joints dans le même dossier et sur le fichier .xlsm exécutez cette macro :
VB:
Sub Assembler()
Dim chemin$, fichier$, feuille$, ncol%, lig&, form$, h&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Keywords" 'nom des feuilles à copier, à adapter
ncol = 15 'nombre de colonnes, à adapter
lig = 2 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1 'CodeName à adapter
    .UsedRange.EntireRow.Offset(1).Delete 'RAZ
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
            h = 0
            On Error Resume Next
            h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'calcul sur colonne 1
            On Error GoTo 0
            If h > 1 Then
                With .Cells(lig, 1).Resize(h - 1, ncol)
                    .FormulaArray = "=" & form & "R2C1:R" & h & "C" & ncol 'formule de liaison matricielle
                    .Value = .Value 'supprime la formule
                    .Replace 0, "", xlWhole 'supprime les zéros
                End With
                lig = lig + h - 1
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Les copies se font par des formules de liaison, l'ouverture des fichiers n'est pas nécessaire.

A+

Bonjour Job75,
Merci pour ton retour rapide. Je viens de tester et rien ne se passe :( Je suis sous MAC / Excel V16.16). Excel me demande si je veux activer la macro du document, je clique sur "Activer les macros" et quand je clique sur ton bouton bleu Assembler, ça load très rapidement mais rien ne se passe.

Idem avec ton fichier mdo100.

Merci,
Jonathan
 

jnce84

XLDnaute Nouveau
Re jnce84,


Tu veux maximiser tes chances sans respecter le travail que les contributeurs vont passer à te répondre !

Et tu oses me dire "j'ai cliqué sur GO et rien ne se passe"

Et bien moi je passe mon tour ! 😖

ah mais ne le prend pas comme ça mdo100 ! Surtout pas je vous suis infiniment reconnaissant de m'aider et bien au contraire je partagerai la solution sur les 3 forums où j'ai demandé :) Je vous respecte totalement et sans vous je n'y arriverai absolument pas. Je suis désolé si tu as mal pris mon "il ne se passe rien" mais ça load 1sec et rien et je ne remonte pas d'erreur dans le fichier donc je ne suis pas quoi te dire de plus que il ne se passe rien :(
 

job75

XLDnaute Barbatruc
Puisque Dir ne veut pas fonctionner sur MAC essayez ce fichier (3) avec :
VB:
Sub Assembler()
Dim chemin$, liste, feuille$, ncol%, lig&, fichier, form$, h&
chemin = ThisWorkbook.Path & Application.PathSeparator 'dossier à adapter
liste = Array("Source1.xlsx", "Source2.xlsx", "Source3.xlsx") 'liste des fichiers, à adapter
feuille = "Keywords" 'nom des feuilles à copier, à adapter
ncol = 15 'nombre de colonnes, à adapter
lig = 2 '1ère ligne de restitution, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Feuil1 'CodeName à adapter
    .UsedRange.EntireRow.Offset(1).Delete 'RAZ
    For Each fichier In liste
        form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
        h = 0
        On Error Resume Next
        h = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'calcul sur colonne 1
        On Error GoTo 0
        If h > 1 Then
            With .Cells(lig, 1).Resize(h - 1, ncol)
                .FormulaArray = "=" & form & "R2C1:R" & h & "C" & ncol 'formule de liaison matricielle
                .Value = .Value 'supprime la formule
                .Replace 0, "", xlWhole 'supprime les zéros
            End With
            lig = lig + h - 1
        End If
    Next
    With .UsedRange: End With 'actualise les barres de défilement
End With
End Sub
Il faut introduire les noms des fichiers à traiter dans l'Array liste.
 

Pièces jointes

  • Assemblage(3).xlsm
    19.8 KB · Affichages: 5

Discussions similaires