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

insulae

XLDnaute Nouveau
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.
 

Pièces jointes

  • 17059_0000B.xlsm
    15.7 KB · Affichages: 4
  • 17059_000ZA.xlsm
    14.8 KB · Affichages: 4
  • 17059_000ZB.xlsm
    15.9 KB · Affichages: 4

job75

XLDnaute Barbatruc

insulae

XLDnaute Nouveau

job75

XLDnaute Barbatruc
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 :
VB:
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
 

Pièces jointes

  • Recap(1).xlsm
    20.6 KB · Affichages: 7
  • 17059_0000B.xlsm
    15.8 KB · Affichages: 6
  • 17059_000ZA.xlsm
    15 KB · Affichages: 5
  • 17059_000ZB.xlsm
    16.1 KB · Affichages: 6
Dernière édition:

insulae

XLDnaute Nouveau
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 :
VB:
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

XLDnaute Barbatruc
Maintenant si l'on veut conserver des noms différents pour les feuilles à consolider il faut ouvrir chaque fichier, voyez ce fichier (2) :
VB:
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
 

Pièces jointes

  • Recap(2).xlsm
    20.6 KB · Affichages: 14
  • 17059_0000B.xlsm
    15.7 KB · Affichages: 8
  • 17059_000ZA.xlsm
    14.8 KB · Affichages: 9
  • 17059_000ZB.xlsm
    15.9 KB · Affichages: 7
Dernière édition:

insulae

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 942
Membres
101 849
dernier inscrit
florentMIG