Bonjour,
comme le précise l'intitulé je souhaiterai créer un bouton qui me permettrait d'exécuter le code ci-dessous, le problème c'est qu'il est assez particulier et je n'arrive pas à créer ce fameux bouton, la situation actuelle est la suivante :
- J'ai deux classeur l'un dans lequel j'ajoute des données, l'autre s'ouvre et ce synchronise lorsque je change de cellule. Je voudrais ne plus effectuer la synchronisation en temps réel (ce qui m'oblige à avoir les deux classeurs ouverts constamment) mais l'effectuer seulement lorsque j'appuie sur le bouton, ce qui implique que la macro doit ouvrir mon classeur à synchronisé, mettre à jour, puis le refermer. Je souhaite faire comme ceux-ci car mon classeur à synchroniser est placé sur le réseau local. Ce classeur doit pouvoir être ouvert par une autre personne tout en étant à jour.
Voici le code initial merci d'avance :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35 Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Const maj = "CopieSuivi_hebdo_beneff.xlsm" ' nom du classeur copie à synchroniser Dim clc As Workbook ' objet classeur copie à synchroniser Dim feu As Integer ' index feuille Dim cl1 As Integer, cl2 As Integer ' index colonnes Dim lig As Long ' lignes de la colonne Dim tba() On Error Resume Next Set clc = Workbooks(maj) If clc Is Nothing Then ' le classeur n'est pas ouvert Workbooks.Open ThisWorkbook.Path & "\" & maj Set clc = Workbooks(maj) If clc Is Nothing Then MsgBox "Classeur à synchroniser absent": Exit Sub End If On Error GoTo 0 For feu = 1 To clc.Sheets.Count ' boucle feuilles du classeur If clc.Sheets(feu).Name = Sh.Name Then For cl1 = 1 To clc.Sheets(feu).UsedRange.Columns.Count ' feuille à synchroniser For cl2 = 1 To Sh.UsedRange.Columns.Count If clc.Sheets(feu).Cells(1, cl1).Value = Sh.Cells(1, cl2).Value Then lig = Sh.Cells(Rows.Count, cl2).End(xlUp).Row If lig > 1 Then ' colonne à synchroniser tba = Sh.Cells(1, cl2).Resize(lig, 1).Value clc.Sheets(feu).Cells(1, cl1).Resize(UBound(tba), 1).Value = tba End If Exit For End If Next cl2 Next cl1 End If Next feu ThisWorkbook.Activate End Sub
Partager