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

[jnce84]

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]

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.

 

[job75]

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 :

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+

 

[mdo100]

Bonjour job75,

Bien que nous arrivions au même résultat, je garde ton code sous le coude.

Merci.

 

[mdo100]

Re jnce84,

jnce84 a écrit :
Merci pour ta réponse @mdo100 ! En effet, j'ai posté sur 3 forums différences pour maximiser mes chances de vite trouver une solution.

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 !

 

[jnce84]

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 :

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]

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

 

[Staple1600]

Bonjour le fil, jnce84, job75, mdo100

Juste pour infos
Dir et MAC ne font pas bon ménage apparemment

Excel 2016 for Mac Compatibility Issue with Dir()

When the following statements are executed in a protected Excel 2016 for Mac VBA environment, the Dir function works correctly if the file is found (i.e. the variable test contains the file name).

answers.microsoft.com

 

[job75]

Re, salut JM,

Ah oui j'oubliais sur MAC le séparateur de chemin n'est pas "\".

Dans ce fichier (2) je l'ai remplacé par Application.PathSeparator.

A+

 

[jnce84]

re job75
j'ai bien mis ton nouveau fichier dans le même répertoire que mes fichiers à assembler et cliqué sur "Assembler" mais même chose, ça change 1sec et le classeur reste vide

 

[jnce84]

pour info j'ai forcé mon répertoire chemin = "/Users/jonathan/Downloads/horizal/exempleforum2/" mais rien non plus

 

[job75]

Puisque Dir ne veut pas fonctionner sur MAC essayez ce fichier (3) avec :

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.

 

[jnce84]

ahhh on commence à avoir quelque chose mais uniquement les DATAS de Source1.xlsx
On avance Merci !

 

[job75]

Si Source1.xlsx est traité il n'y a pas de raison que les autres fichiers ne le soient pas s'ils sont bien listés et s'ils existent dans le dossier.

 

[jnce84]

Si Source1.xlsx est traité il n'y a pas de raison que les autres fichiers ne le soient pas s'ils sont bien listés et s'ils existent dans le dossier.

ils sont tous dans le répertoire en question. J'ai bien vérifié :/