MerciBonjour 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.
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
Merci !!! Je ferai un essai et reviendrai vers vous. Bonne journéeTé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 :
Important : j'ai mis le même nom de feuille Feuil1 aux 3 fichiers à consolider.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
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
Super !!! Tout est ok. Merci beaucoup !!!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.
Cette question est incomplète car a priori il peut y avoir des noms de communes différents en colonne H.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.
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.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.
S'il n'y a aucune macro dans vos fichiers sources je ne sais pas car je ne suis pas sur MAC.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.
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.