XL 2019 Regrouper données de plusieurs fichiers xlsm en un seul fichier xlsm

[insulae]

Bonjour,

Comment regrouper les données (les ajouter les une derrière les autres) de plusieurs fichiers xlsm en un seul fichier xlsm (macro ? Sous Mac).

Merci.

 

[job75]

Bonjour insulae, le forum,

Si vous aviez lu la Charte du forum vous auriez vu que les mots URGENT, SOS etc... sont à bannir.

Et une recherche sur le mot consolider donne pas mal de solutions, en particulier celle-ci toute récente :

https://www.excel-downloads.com/threads/consolider-plusieurs-fichiers-excel-dans-un-seul.20038232/

Il faudra peut-être modifier un peu pour MAC, dites-nous où il y a bug.

Bonne journée.

 

[insulae]

Bonjour insulae, le forum,

Si vous aviez lu la Charte du forum vous auriez vu que les mots URGENT, SOS etc... sont à bannir.

Et une recherche sur le mot consolider donne pas mal de solutions, en particulier celle-ci toute récente :

https://www.excel-downloads.com/threads/consolider-plusieurs-fichiers-excel-dans-un-seul.20038232/

Il faudra peut-être modifier un peu pour MAC, dites-nous où il y a bug.

Bonne journée.

Merci

 

[job75]

Téléchargez les 4 fichiers joints dans le même répertoire (le bureau) et ouvrez le fichier Recap.xlsm(1).

Lancez cette macro par les touches Ctrl+M et dites-nous ce qu'il en est :

Sub MAJ()
Dim chemin$, fichier$, feuille$, ncol%, lig&, f$, derlig As Variant, ad$
chemin = ThisWorkbook.Path & Application.PathSeparator 'à adapter événtuellement
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
feuille = "Feuil1" 'nom de la feuille à copier dans les fichiers
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille des résultats, à adapter
    .Rows("2:" & Rows.Count).Delete xlUp 'RAZ
    ncol = .[A1].CurrentRegion.Columns.Count
    lig = 2
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            f = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
            derlig = ExecuteExcel4Macro("MATCH(9^99," & f & "R1C1:R1048576C1)")
            If IsNumeric(derlig) Then
                If derlig > 1 Then
                    ad = .Cells(2, 1).Resize(derlig - 1, ncol).Address
                    With .Cells(lig, 1).Resize(derlig - 1, ncol)
                        .FormulaArray = "=" & f & ad 'formule de liaison matricielle
                        .Value = .Value 'supprime la formule
                    End With
                    lig = lig + derlig - 1
                End If
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les zéros
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

Important : j'ai mis le même nom de feuille Feuil1 aux 3 fichiers à consolider.

Edit : ajouté à la fin .Columns.AutoFit 'ajustement largeurs

 

[insulae]

Téléchargez les 4 fichiers joints dans le même répertoire (le bureau) et ouvrez le fichier Recap.xlsm(1).

Lancez cette macro par les touches Ctrl+M et dites-nous ce qu'il en est :

Sub MAJ()
Dim chemin$, fichier$, feuille$, ncol%, lig&, f$, derlig As Variant, ad$
chemin = ThisWorkbook.Path & Application.DecimalSeparator 'à adapter événtuellement
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
feuille = "Feuil1" 'nom de la feuille à copier dans les fichiers
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille des résultats, à adapter
    .Rows("2:" & Rows.Count).Delete xlUp 'RAZ
    ncol = .[A1].CurrentRegion.Columns.Count
    lig = 2
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            f = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
            derlig = ExecuteExcel4Macro("MATCH(9^99," & f & "R1C1:R1048576C1)")
            If IsNumeric(derlig) Then
                If derlig > 1 Then
                    ad = .Cells(2, 1).Resize(derlig - 1, ncol).Address
                    With .Cells(lig, 1).Resize(derlig - 1, ncol)
                        .FormulaArray = "=" & f & ad 'formule de liaison matricielle
                        .Value = .Value 'supprime la formule
                    End With
                    lig = lig + derlig - 1
                End If
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    .UsedRange.Replace 0, "", xlWhole 'supprime les zéros
End With
End Sub

Important : j'ai mis le même nom de feuille Feuil1 aux 3 fichiers à consolider.

Merci !!! Je ferai un essai et reviendrai vers vous. Bonne journée

 

[job75]

Maintenant si l'on veut conserver des noms différents pour les feuilles à consolider il faut ouvrir chaque fichier, voyez ce fichier (2) :

Sub MAJ()
Dim chemin$, fichier$, lig&, w As Worksheet, derlig&
chemin = ThisWorkbook.Path & Application.PathSeparator 'à adapter événtuellement
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille des résultats, à adapter
    .Rows("2:" & Rows.Count).Delete xlUp 'RAZ
    lig = 2
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            Set w = Workbooks.Open(chemin & fichier).Sheets(1) 'ouverture du fichier
            If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
            derlig = w.Cells(w.Rows.Count, 1).End(xlUp).Row
            If derlig > 1 Then
                w.Rows(2).Resize(derlig - 1).Copy .Cells(lig, 1) 'copier-coller
                lig = lig + derlig - 1
                w.Parent.Close False
            End If
        End If
        fichier = Dir 'fichier suivant
    Wend
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

 

[job75]

Faites attention au post #4 j'avais mis Application.DecimalSeparator c'est bien sûr Application.PathSeparator

Et n'oubliez pas de tester le fichier (2) du post #6.

 

[insulae]

Faites attention au post #4 j'avais mis Application.DecimalSeparator c'est bien sûr Application.PathSeparator

Et n'oubliez pas de tester le fichier (2) du post #6.

Super !!! Tout est ok. Merci beaucoup !!!
Peut t-on ajouter un code pour "enregistrer sous..." en fin d'éxé ? Pour enregistrer le fichier final sous un nom de fichier particulier (nom de la commune en question par exemple) ? Merci de votre aide précieuse.

 

[job75]

Peut t-on ajouter un code pour "enregistrer sous..." en fin d'éxé ? Pour enregistrer le fichier final sous un nom de fichier particulier (nom de la commune en question par exemple) ? Merci de votre aide précieuse.

Cette question est incomplète car a priori il peut y avoir des noms de communes différents en colonne H.

Il faudra donc filtrer le tableau sur chaque nom de commune et créer un fichier (.xlsx pour qu'il n'y ait pas de macro) pour chaque commune.

C'est un autre problème que celui du post #1, ouvrez donc une nouvelle discussion en précisant ce que vous voulez faire exactement.

 

[insulae]

Cette question est incomplète car a priori il peut y avoir des noms de communes différents en colonne H.

Il faudra donc filtrer le tableau sur chaque nom de commune et créer un fichier (.xlsx pour qu'il n'y ait pas de macro) pour chaque commune.

C'est un autre problème que celui du post #1, ouvrez donc une nouvelle discussion en précisant ce que vous voulez faire exactement.

Petit soucis avec le fichier Recap... Demande d'accès à chaque fichier qui doit être ouvert. Peut-être un paramètre de mon ordi ? Merci.

 

[job75]

Petit soucis avec le fichier Recap... Demande d'accès à chaque fichier qui doit être ouvert. Peut-être un paramètre de mon ordi ? Merci.

S'il n'y a aucune macro dans vos fichiers sources je ne sais pas car je ne suis pas sur MAC.

Utilisez la macro du post #4 qui n'ouvre pas les fichiers.

 

[insulae]

S'il n'y a aucune macro dans vos fichiers sources je ne sais pas car je ne suis pas sur MAC.

Utilisez la macro du post #4 qui n'ouvre pas les fichiers.

Merci !