fusion

[syphon]

Bonjour le Forum,

J'en reviens à vous une fois de plus afin de bénéficier de vos lumières

J'ai un fichier excel servant de modèle.

Ce fichier doit être distribué à une centaine de personne. Chaque jour, chacune des cents personnes doit envoyer son fichier complété par mail à un gestionnaire unique.

Y'a-t'il un moyen pour le gestionnaire de fusionner ces 100 fichiers en un seul pour lui éviter d'ouvrir chacun des 100 fichiers ?

Je précise que chaque fichier est renvoyé par mail et qu'il n'y a aucun dossier partagé sur un server ou autre permettant une comparaison et fusion de classeurs via le menu Outils.

Merci d'avance

 

[orphelion]

Re : fusion

Bonjour Syphon,

voici un code qui devrait te sauver, je l'espere en tout cas. je l'affectionne tout particulierement

Sub Format_Results()
  Dim SrcBook As Workbook
  Dim fso As Object, f As Object, ff As Object, f1 As Object
  Dim SPath As String
  Application.ScreenUpdating = False
  Set fso = CreateObject("Scripting.FileSystemObject")
  ' Ouvrir la boite de dialogue pour choix du dossier
  SPath = GetFolder("C:\")
  If SPath = "" Then Exit Sub
  ' Définir ce dossier par défaut dans FSO
  Set f = fso.GetFolder(SPath)
  Set ff = f.Files
  
  For Each f1 In ff
    Set SrcBook = Workbooks.Open(f1)'
'decide de la section a copier ci dessous
    Range("A1:N" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Worksheets(1).Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                               :=False, Transpose:=False
    Application.CutCopyMode = False
    SrcBook.Close
  Next
End Sub

ce code permet de selectionner un dossier ou tu compiles les fichiers de tous tes clients/collegues(...) et de fusionner dans un meme feuillet la zone de leur feuille qui t'interesse. si tous les utilisateurs on un modele type tu pourra recuperer tout sans accro.

a+

 

[syphon]

Re : fusion

Rebonjour,

Je n'ai pas eu l'opportunité de donné une suite plus rapidement à mon premier message m'étant rendu à l'étranger.

Déjà merci pour ton code Orphelion, tu sembles avoir bien cerné mon problème.

J'ai cependant encore un soucis car j'ai fais un copier coller de ton code pour l'affecter à un bouton de commande et lorsque je click dessus, il ne se passe rien.

Une idée?

Merci encore

 

[orphelion]

Re : fusion

Bonjour Syphon,

je crois t'avoir repondu en MP. est ce que tu peux joindre ton fichier histoire d'y voir plus clair dans ce qui ne fonctionne pas.
a+

 

[syphon]

Re : fusion

Certainement, je joins le fichier test à cette réponse.

Le fichier ne contient qu'un simple bouton de commande ... pas besoin de plus pour tester la macro me semble-t'il ...

Merci de ton aide

 

[orphelion]

Re : fusion

Bonjour Syphon, le Forum,

je suis alle un peu vite la derniere fois et j'avoue que ca m'a bien pris 5 minutes ce matin pour retrouver ce qui manquait haha
bref voici la version complete qui definit GetFolder et reponds au message d'erreur d'excel

Sub Format_Results()
   
Dim SrcBook As Workbook
  Dim fso As Object, f As Object, ff As Object, f1 As Object
  Dim SPath As String
  Application.ScreenUpdating = False
  Set fso = CreateObject("Scripting.FileSystemObject")
  ' Ouvrir la boite de dialogue pour choix du dossier
  SPath = GetFolder("C:\")
  If SPath = "" Then Exit Sub
  ' Définir ce dossier par défaut dans FSO
  Set f = fso.GetFolder(SPath)
  Set ff = f.Files
  
  For Each f1 In ff
    Set SrcBook = Workbooks.Open(f1)
    Range("A1:N" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Worksheets(1).Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                               :=False, Transpose:=False
    Application.CutCopyMode = False
    SrcBook.Close
  Next
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        Range("A1:N" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        SrcBook.Close
    Next

End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Je te laisse jouer avec pour le rendre plus confortable dans l'utilisation, tu peux modifier le dossier d'ouverture pour la recherche de ton dossier en remplacant C:/ par une destination plus proche dans l'arborescence si cela t'es utile, changer la zone de copier coller etc...
tout cela colle dans un module ou avec une private sub command_button comme tu avais commence.

a+

Ps: un fichier exemple attache avec boutons pour fusionner ou effacer le tableau

 

[orphelion]

Re : fusion

Syphon,
comme precise en MP je te reponds ici pour faire beneficier de la reponse a toute personne possiblement interessee par le sujet.

Le code tel que mentionne ci dessus te donne la possibilite de copier des feuilles excel ensemble (fusion theme de ta question)
pour attribuer ce code a un bouton, il te suffit de creer un bouton (developpeur/insert/form control) et de faire clic droit pour attribuer la macor.
la macro en question n'est contitue que du sub mergeautosheet(). la fonction Getfolder est 'incrustee" dedans directement.
le bout de code cite plus haut doit etre copie dans un module VBE, sub et fonction a la suite l'un de l'autre tel que presente. pas d'astuce particuliere de ce cote la.

J'espere avoir ete clair.
bonne continuation

 

[orphelion]

Re : fusion

plus haut dans le fil un fichier exemple attache.
a+