Fusionner plusieurs fichiers en un seul
Bonjour,
Je suis nouveau sur le site, j’aurais besoin de votre aide sur un cas concret.
J’ai plusieurs fichier excel qui ont la même structure, je voudrais créer un fichier qui ferait la synthèse d’un des onglets des différents fichiers
Vous trouverez en pièce jointe la structure des fichiers à fusionner (j’ai du les modifier pour des questions de confidentialité) :
Portefeuille 1.xlsm
Portefeuille 2.xlsm
En réalité certaines colonnes des ces tableaux comportent des formules avec dans certains cas des références externes (je me doute que cela peut avoir des incidences sur le code à mettre en place)
L’objectif n’est pas de conserver ces formules dans le fichier de synthèse : un collage spécial valeur correspondrait au besoin
L’objectif est de rapatrier les infos des onglets « En cours » des fichiers « Portefeuille 1.xlsm » et « Portefeuille 2.xlsm » dans l’onglet « Synthèse » du fichier « Synthèse des portefeuilles.xls »
Vous trouverez ci-dessous le code que je me suis essayé d’adapter à mon cas :
Sub Transferer()
Dim dossier As Object, Fichier As Object
Dim Chemin As String
Dim Derlg As Integer
Dim c As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = True
Derlg = Range("A65536").End(xlUp).Row + 1
Range("A3:AT" & Derlg).Clear
Chemin = ThisWorkbook.Path
FName = Dir(Chemin & "\" & "*.xlsm")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "Synthèse des portefeuilles.xls" Then
Derlg = Range("A65536").End(xlUp).Row + 1
Workbooks.Open Filename:=Chemin & "\" & NomFichier
On Error Resume Next
With Workbooks(NomFichier)
.Sheets("En cours").Range("A3:AT" & Sheets("En cours").Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Sheets("Synthèse").Range("A" & Derlg)
.Close
End With
End If
Next
Range("A3:AT" & Derlg).Sort Key1:=Range("K3")
Cells.FormatConditions.Delete
For Each c In Range("L3:L" & Derlg)
If c < Date Then c.Font.ColorIndex = 3
Next c
End Sub
Plusieurs messages s’affichent lorsque j’exécute la macro, peut-on s'en affranchir ?
Message 1 : "une feuille ou une formule que vous voulez déplacer contient le nom "X" qui existe déjà sur la feuille de destination..." Je réponds oui
Message 2 : "voulez-vous enregistrer les modifications sur le fichier Portefeuille 1.xlsm", je réponds Non
Message 3 : "le fichier contient une ou plusieurs liaisons qui ne peuvent pas être mises à jour..." je répond continuer
NB : la macro est très longue à exécuter…
D’autre part j’aimerai compléter la macro pour :
- Permettre de localiser le fichier ailleurs que dans le dossier avec les fichiers à fusionner, est-ce possible ?
- Ne récupérer que les colonnes A, B, D, F, N, T, Z, AB dans le fichier de synthèse
- Peut-on conserver la mise en forme des fichiers d’origine
Je suis vraiment intéressé par vos retours sachant que j’aimerais apprendre à écrire mes propres macros.
Pourriez-vous svp me mettre des commentaires dans le code me permettant de le comprendre et de me l’approprier ?
Merci par avance pour votre aide
Damien
Salut,
Je n’ai pas bien compris pourquoi tu avais mis pratiquement la même macro sur le code de la feuille et dans un module. J’ai commencé à corriger le code de la feuille et quand je m’en suis rendu compte, j’ai effacé le code du module et j’ai transféré celui de la feuille dans le module.
Ensuite j’ai mis quelques commentaires directement dans le code, avec quelques corrections.
A te relire.
Bonjour et merci pour ta réponse et ton temps Yvouille.
J'étais en long déplacement pro puis en vacances je n'avais pas pris le temps de me connecter pour répondre.
J'ai testé ton fichier corrigé mais cela ne semble pas fonctionner avec les fichiers d'origine qui mettent en oeuvre des liens extérieurs
Que puis-je faire pour vous aider à m'aider ?
Merci par avance
Damien
Re-bonjour,
Longtemps plus vu
damienp a écrit :J'ai testé ton fichier corrigé mais cela ne semble pas fonctionner avec les fichiers d'origine qui mettent en oeuvre des liens extérieurs
Que puis-je faire pour vous aider à m'aider ?
Nous fournir les fichiers d'origine qui créent problèmes
Si tu désires me fournir tes fichiers confidentiels en privé, indique-le-moi et je te fournis mon adresse personnelle.
Cordialement.