compiler plusieurs fichiers excel dans une feuille avec macro

[ahlamine]

bj..jai besoin de compiler les données de plusieurs fichiers excel dans une seul feuille...merci de me communiquer la macro.
ci_joint les 3 fichiers...c'est juste un exemple

 

[Staple1600]

Bonjour

Faire une recherche avec le moteur interne du forum

Rechercher des discussions

www.excel-downloads.com

Cette question a été traitée de nombreuses fois ici.

 

[zebanx]

bj..jai besoin de compiler les données de plusieurs fichiers excel dans une seul feuille...merci de me communiquer la macro.
ci_joint les 3 fichiers...c'est juste un exemple

Bonjour Alhamine, Staple1600

C'est surement un clin d'oeil au procès de France Tel.
....

 

[Staple1600]

Bonsoir zebanx

Je te laisse réécrire la boucle qui compile N Sheets dans une MasterSheet
(Si le cœur t'en dit)

Je crois que le point 1) [Section Demandeur], de la charte sert de moins en moins, non?

 

[zebanx]

Je crois que le point 1) [Section Demandeur], de la charte sert de moins en moins, non?

On demande souvent de la bienvaillance aux "répondeurs", c'est normal et cela a été rappelé récemment par David.

On ne doit plus trouver étrange de parfois louper des trucs comme bonjour, SVP, des figures de style "je voudrais... merci" avec un résumé en deux lignes (pour montrer à quel point on a cherché l'info) mais là... le "merci de" c'est, pour moi, un cap au-dessus.

Le problème sera traité et je ne doute pas qu'il n'y a pas d'intentionalité, juste pas l'envie de se relire, et parce que c'est une demande courante sur le site comme tu l'as indiqué au 2. Et c'est là l'essentiel.

Sur ce, bonne soirée.

 

[Staple1600]

Re

zebanx
Je ne vois aucune malveillance dans mes deux messages

Je remarque juste que la quasi-totalité des nouveaux membres loupent systématiquement cette "accroche"

 

[Staple1600]

Re

ahlamine
Donc merci le moteur de recherche du forum
Ci-dessous un exemple (non choisi au hasard )

https://www.excel-downloads.com/thr...ts-excel-en-un-seul.98695/page-2#post-1406090

zebanx
Moi quand je lis communiqué, je pense aussitôt à cela

 

[zebanx]

Oups !

Le bonjour était pour vous deux et la remarque du #2 n'était que pour le demandeur et sa sémantique particulière (Sur le #4, je réponds au point de charte que tu évoques et que tu as bien fait de reporter )

Désolé d'avoir été à mon tour peu précis, dans les deux messages d'ailleurs. Je ne pensais pas qu'il y aurait confusion, ce fut pourtant le cas et deux fois en plus.
Sur ce re-bonne soirée à toi.

Et keep cool avec DireStraits, merci !

 

[Staple1600]

Et keep cool avec DireStraits, merci !

Je ne comprends pas cette phrase
Ou plutôt je ne sais comment l'interpréter?
keep cool = mollo sur Dire Straits
ou
keep cool (moi zebanx) je n'aime pas Dire Straits

 

[zebanx]

Oh là là.... J'ai bien aimé. Fin du sujet, je pollue un fil trop inutilement là.
@+

 

[Staple1600]

Re

Pas de pollution à l'horizon puisque la question est résolue depuis le post#7
Par contre le demandeur tarde à repointer le bout de son nez
(Sans doute un fan du Barca )

 

[job75]

Bonsoir à tous,

Je trouve un peu pénibles les fils qui tournent en rond sans donner de véritables solutions.

Cette macro dans le ThisWorkbook du fichier Consolidation(1).xlsm tient la route :

Private Sub Workbook_Activate()
Dim chemin$, a, feuille$, fichier, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'à adapter
a = Array("1.xlsx", "2.xlsx", "3.xlsx") 'liste à adapter
feuille = "Tuteur" 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With Feuil1 'CodeName
    .Cells.Delete 'RAZ
    For Each fichier In a
        Set wb = Workbooks.Open(chemin & fichier) 'ouverture du fichier
        wb.Sheets(feuille).UsedRange.Copy
        .[A1].Insert xlDown
        Application.CutCopyMode = 0
        wb.Close False 'fermeture du fichier
    Next
    .UsedRange.Sort .Columns(1), xlAscending, Header:=xlNo 'tri
    .UsedRange.RemoveDuplicates Array(1, 2), Header:=xlNo 'supprime les doublons
    .Rows(.[A1].CurrentRegion.Rows.Count + 1 & ":" & .Rows.Count).Delete 'RAZ en dessous
    .Columns.AutoFit 'ajustement largeur
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Les fichiers joints sont à télécharger dans le même répertoire (le bureau).

Bonne nuit.

 

[Staple1600]

Bonjour job75

Je trouve ... sans donner de véritables solutions.

Il y a plusieurs solutions à disposition dans le message#7 en lisant le fil cité...
(qu'il suffit d'adapter).

Pour le reste, cela ne regarde que toi.

 

[job75]

Bonjour le fil, le forum,

Une solution plus élaborée dans ce fichier (2) avec une 3ème colonne indiquant le fichier source :

Private Sub Workbook_Activate()
Dim chemin$, a, feuille$, fichier, F As Worksheet
chemin = ThisWorkbook.Path & "\" 'à adapter
a = Array("1.xlsx", "2.xlsx", "3.xlsx") 'liste à adapter
feuille = "Tuteur" 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité si un fichier n'existe pas
With Feuil1 'CodeName
    .Cells.Delete 'RAZ
    For Each fichier In a
        Set F = Workbooks.Open(chemin & fichier).Sheets(feuille) 'ouverture du fichier
        F.UsedRange.Columns(3).ReadingOrder = xlLTR 'de gauche à droite
        F.UsedRange.Columns(3) = "=REPT(""" & fichier & """,COUNTA(RC[-2]:RC[-1])>0)"
        F.UsedRange.Columns(3) = F.UsedRange.Columns(3).Value 'supprime les formules
        F.UsedRange.Copy
        If Application.CutCopyMode Then .[A1].Insert xlDown
        Application.CutCopyMode = 0
        F.Parent.Close False 'fermeture du fichier
    Next
    .UsedRange.Sort .Columns(1), xlAscending, Header:=xlNo 'tri
    .UsedRange.RemoveDuplicates Array(1, 2), Header:=xlNo 'supprime les doublons
    .Rows(.[A1].CurrentRegion.Rows.Count + 1 & ":" & .Rows.Count).Delete 'RAZ en dessous
    .Columns.AutoFit 'ajustement largeur
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Bonne journée.