Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
J'ai créer cette macro pour actualiser une autre fichier.
La macro ouvre le fichier de destination, effectue des copies de données, enregistre et ferme le fichier de destination.
Fichier Source : "Fichier Gestion.xlsm" (dans lequel se trouve la macro)
Fichier Destination : Gestion_ Teams.xlsx
Je souhaite savoir s'il est possible de réaliser les mêmes étapes sans devoir ouvrir et fermer le fichier de destination car ces actions font "clignoter" mes fichiers Excel.
VB:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Workbooks.Open Filename:="C:\Users\CE\OneDrive - Truck\PAE\Gestion_ Teams.xlsx", _
UpdateLinks:=True
Workbooks("Fichier Gestion.xlsm").Activate
Range("D3:D500").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks("Gestion PAE _ Teams.xlsx").Activate
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks("Fichier Gestion.xlsm").Activate
Range("B1").Select
End Sub
ça "clignote" parce que vous faites des sélections et que vous ne masquez pas les actions.
Une solution sans sélection mais qui est identique en terme de fonctionnalité (non testé)
VB:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
Const Fichier_Source As String = "Fichier Gestion.xlsm"
Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
Application.ScreenUpdating = False
Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True
Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats
Workbooks(Fichier_Destination).Save
Workbooks(Fichier_Destination).Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Merci beaucoup pour cette proposition qui fonctionne parfaitement.
Je dois avouer qu'étant donné mon faible niveau en VBA, j'avais en partie utilisé la fonction enregistrement.
Suite à l'aide de @Nain porte quoi, j'ai bien avancé mais je rencontre désormais un autre problème.
Mes fichiers sont stockés sur un Sharepoint et le code VBA fonctionne pour moi mais pour mon collègue car le code point vers mon C:\.
Je me demandais s'il serait possible d'enchaîner deux fois mon code avec les chemins de chaque C:\.
Voici mon idée, mais je ne sais pas si cela peut fonctionner et surtout je ne sais pas comment écrire le code pour faire un test.
Voici à quoi cela pourrait ressembler :
VB:
VB:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Utilisateur 1 (CE)
Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
Const Fichier_Source As String = "Fichier Gestion.xlsm"
Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
Application.ScreenUpdating = False
Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True
Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats
Workbooks(Fichier_Destination).Save
Workbooks(Fichier_Destination).Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Utilisateur 2 (BV)
Const Nom_Chemin As String = "C:\Users\BV\OneDrive - Truck\PAE\"
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
Const Fichier_Source As String = "Fichier Gestion.xlsm"
Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
Application.ScreenUpdating = False
Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True
Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats
Workbooks(Fichier_Destination).Save
Workbooks(Fichier_Destination).Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Merci pour cette nouvelle proposition qui me semble fonctionnelle. J'ai ajouté ce morceau de code et ça fonctionne toujours mais je n'ai pas eu la possibilité de tester sur la session de mon collègue qui est absent.
Code:
Dim Nom_Chemin As String
Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"
J'ai donc désormais ce code:
Code:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim Nom_Chemin As String
Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
Const Fichier_Source As String = "Fichier Gestion.xlsm"
Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
Application.ScreenUpdating = False
Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True
Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats
Workbooks(Fichier_Destination).Save
Workbooks(Fichier_Destination).Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Je viens de constater un autre problème concernant la copie de la colonne D (Range("D3 : 500") qui ne fonctionne pas si le fichier de destination n'est pas ouvert.
En théorie la VBA est lancée à l'enregistrement du fichier source. La VBA est doit ouvrir le fichier de destination, copie les données (données avec lien hypertexte), enregistré et fermé le fichier de destination.
En l'état si les deux fichiers sont ouverts, alors la VBA fonctionne et fini mettre les données à jours puis par fermé le fichier de destination.
Vois-tu un problème qui pourrait expliquer cela dans le code car je ne vois pas où est le problème.
Sachant que que je passe par cette VBA pour copier les datas qui sont des lien hypertexte étant que je n'arrive pas à copier les liens hypertexte via de la référence circulaire.
C'est quoi le problème concrètement ?
N'oubliez pas que je ne vois pas par dessus votre épaule, que je ne connais pas votre job ni votre environnement de travail ni etc etc
Sachant que que je passe par cette VBA pour copier les datas qui sont des lien hypertexte étant que je n'arrive pas à copier les liens hypertexte via de la référence circulaire.
Je suis désolé de ne pas avoir été clair. Je vais essayer d'expliquer le plus correctement possible.
- J'ai un Fichier Source "Fichier Gestion.xlsm" qui contient le code VBA.
- J'ai un Fichier Destination "Gestion_ Teams.xlsx".
- Le Fichier Source "Fichier Gestion.xlsm" alimente le fichier Fichier Destination "Gestion_ Teams.xlsx".
- Indépendamment du code VBA j'alimente une partie des champs via une formule de renvoi (Fichier Source B3 = Fichier Destination B3 etc...)
- J'utilise le code VBA pour gérer la copie de la colonne D car via la formule le lien hypertexte est absent du Fichier Destination "Gestion_ Teams.xlsx".
Je pense qu'il faudrait supprimer les filtres dans les 2 fichiers avant de lancer la copie de la colonne D car visiblement ça fonctionne mail lorsqu'un filtre est présent.
- Les deux fichiers sont stockés sur un Sharepoint (Teams) mais pas dans le même répertoire. Le code utilise un emplacement du lecteur "C:\ mais qui se synchronise correctement sur Teams. J'utilise cette partie du code afin que mon collègue puisse également utiliser le fichier XLSM
VB:
Dim Nom_Chemin As String
Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"
- Le but est de partager le Fichier Destination "Gestion_ Teams.xlsx" via Teams pour d'autres utilisateurs en mode lecture et que les données soient synchronisés en permanence.
- A l'utilisation, le but est de ne pas ouvrir manuellement le Fichier Destination "Gestion_ Teams.xlsx" . Le Fichier Source "Fichier Gestion.xlsm" est ouvert et l'enregistrement du Fichier Source "Fichier Gestion.xlsm" doit générer la mise à jour du Fichier Destination "Gestion_ Teams.xlsx"
- Le but final est d'avoir un Fichier Destination "Gestion_ Teams.xlsx" synchronisé sur un Sharepoint (Teams)
Avec la version du code actuel, je constate que:
--> Le code fonctionne correctement si les 2 fichiers sont ouverts. Après un enregistrement du Fichier Source "Fichier Gestion.xlsm" les données de la colonne D se mettent à jours dans le Fichier Destination "Gestion_ Teams.xlsx" et le Fichier Destination "Gestion_ Teams.xlsx" se ferme
--> Le code ne fonctionne pas si je le Fichier Source "Fichier Gestion.xlsm" est ouvert et que le Fichier Destination "Gestion_ Teams.xlsx" est fermé. Je constate aucune mise à jours des données de la colonne D dans le Fichier Destination "Gestion_ Teams.xlsx"
J'ai préparé deux fichiers exemples sans les datas pro.
Pour finir, a terme je vais avoir besoin d faire la même chose avec un deuxième onglet dans chaque fichier.
Encore merci @Nain porte quoi pour le temps consacré à mon sujet.
voici la version corrigée, mais je ne comprend pas bien le problème des liens hypertextes et du coup, vu qu'il y a des copies à faire, pourquoi ne pas tout copier en remplacement des formules de calculs qui sont plus lentes.
VB:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Application.ScreenUpdating = False
' def de la source (qui est le fichier actuel)
Const Fichier_Source As String = "Fichier Gestion.xlsm"
Const Feuille_Source As String = "SUIVI OPTION"
Dim WS_Source As Worksheet
Set WS_Source = Workbooks(Fichier_Source).Worksheets(Feuille_Source)
' affiche toutes les données source
If WS_Source.FilterMode = True Then WS_Source.ShowAllData
' def de la destination
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination As String = "BM"
' ouvre le fichier destination
Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True
Dim WS_Destination As Worksheet
Set WS_Destination = Workbooks(Fichier_Destination).Worksheets(Feuille_Destination)
' affiche toutes les données du fichier destination
If WS_Destination.FilterMode = True Then WS_Destination.ShowAllData
' copy les données de D3 à la dernière ligne de la colonne D
Dim Der_Ligne
Der_Ligne = WS_Source.Range("D" & Rows.Count).End(xlUp).Row
WS_Source.Range("D3:D" & Der_Ligne).Copy
' colle les données dans la classeur destination
WS_Destination.Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats
' enregistre et ferme le fichier destination
Workbooks(Fichier_Destination).Close SaveChanges:=True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Pour répondre à différents problèmes j'ai finalement opté pour copier l'intégralité des données via VBA.
Je rencontre désormais une autre difficulté pour réaliser les mêmes opérations sur une 2ème onglet mais je n'arrive pas à enchaîner les actions.
J'ai tout d'abord modifié la partie "def de la destination" de la manière suivante:
VB:
' def de la destination
Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
Const Feuille_Destination_BM As String = "BM"
Const Feuille_Destination_SUFO As String = "SUFO"
J'ai voulu ajouter les actions en lien avec l'onglet de destination "SUFO" juste avant la partie "enregistre et ferme le fichier destination" mais cela ne fonctionne pas malgré de nombreux essai :-( .
Pour finir, je me demande comment je pourrais faire pour éventuellement passer de cet Workbook_AfterSave vers un lancement du code de synchronisation à heure fixe (par exemple 10h + 16h) ou bien genre tous les 4 heures.
Si tu peux m'aider pour ces dernières étapes, cela serait vraiment sympa.
Dans tous les cas, @Nain porte quoi , je te remercie pour le temps déjà passé sur mon sujet.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD