XL 2010 Lier deux cellules de classeurs différents. [RESOLUE]

[AngelNight]

Bonjour à tous,

Je souhaiterais lier deux cellules de deux classeurs différents, qui ne seront pas ouvert en même temps.

Exemple :
• Si je modifie la cellule A1 du classeur 1, ça se répercute automatiquement dans la cellule A1 du classeur 2.
• Et inversement : si je modifie la cellule A1 du classeur 2, ça se répercute automatiquement dans la cellule A1 du classeur 1.

Cette formule de "BOISGONTIER" correspond à ce que je cherche, mais seulement pour deux cellules du même classeur :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then
Sheets(2).[A3] = Target
End If
End Sub

(Source : https://www.excel-downloads.com/threads/lier-deux-cellules.100601/#post-571335)

Mes connaissances en VBA sont très limités, donc je serais reconnaissant si vous pouviez fournir une réponse détaillé et facilement compréhensible.

Je vous remercie par avance.

Cordialement,
AngelNight

 

[Iznogood1]

MISE A JOUR APRES LA REMARQUE DE JOB CI-DESSOUS
(merci Job)

Bonjour,

ci-joint 2 classeurs dont les cellules A1 de Feuil1 sont synchronisées.

Le principe: quand on change le contenu de la cellule A1, on sauvegarde ce contenu le registre windows

Dans Feuil1

Private Sub Worksheet_Change(ByVal Target As Range)

  If Not Intersect([A1], Target) Is Nothing Then SaveSetting "Sync", "data", "A1", [A1].Formula
End Sub

Quand on active l'autre classeur, on récupère le contenu du registre et on l'affecte à A1 de Feuil1

Dans ThisWorkbook

Private Sub Workbook_Activate()
  Feuil1.[A1].Value = GetSetting("Sync", "data", "A1", "")
End Sub

 

[job75]

Bonjour AngelNight,Iznogood1,

Deux remarques Iznogood1 :

- Worksheet_SelectionChange ne va pas, remplacer par Worksheet_Change.

- si l'on ferme le fichier modifié sans l'enregistrer il y aura un problème...

A+

 

[job75]

Re,

Pour éviter le problème que j'ai soulevé enregistrer le classeur à chaque modification de A1 :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([A1], Target) Is Nothing Then _
  SaveSetting "Sync", "data", "A1", [A1].Formula: ThisWorkbook.Save
End Sub

A+

 

[AngelNight]

Bonjour à tous les deux,

Merci pour vos réponses claires et détaillées que j'ai pu mettre en application, et qui conviennent parfaitement.

En vous souhaitant une bonne journée.

Cordialement,
Angel

 

[job75]

Bonjour AngelNight,Iznogood1, le forum,

La solution avec SaveSetting va bien à condition qu'il n'y ait qu'un seul utilisateur des fichiers.

Si les fichiers peuvent être ouverts par plusieurs utilisateurs voici une solution :

Private Sub Workbook_Activate()
Dim i%, dat As Date, memdat As Date, n%, wb As Workbook, ouvre As Boolean
'---initialisations à adapter---
Dim chemin(1 To 2), fichier(1 To 2)
chemin(1) = Me.Path & "\"
chemin(2) = Me.Path & "\"
fichier(1) = "Fichier1.xlsm"
fichier(2) = "Fichier2.xlsm"
'---dates/heures de dernière modification---
On Error Resume Next 'si un fichier n'est pas trouvé
For i = 1 To UBound(chemin)
  dat = 0
  dat = FileDateTime(chemin(i) & fichier(i))
  If dat > memdat Then memdat = dat: n = i
Next
If Me.FullName = chemin(n) & fichier(n) Then Exit Sub
'---copie la cellule "Cible"---
Application.EnableEvents = False 'désactive les évènements
Set wb = Workbooks(fichier(n))
If wb Is Nothing Then ouvre = True: Application.ScreenUpdating = False: _
  Set wb = Workbooks.Open(chemin(n) & fichier(n))
Evaluate("'" & wb.Name & "'!Cible").Copy Evaluate("'" & Me.Name & "'!Cible") 'cellules nommées
If ouvre Then wb.Close False
Application.EnableEvents = True ' réactive les évènements
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With Evaluate("'" & Me.Name & "'!Cible") 'cellule nommée
  If Sh.Name = .Parent.Name Then If Not Intersect(Target, .Cells) Is Nothing Then Me.Save
End With
End Sub

Les fichiers doivent avoir des noms différents et toutes les cellules synchronisées sont nommées Cible.

Fichiers joints à télécharger dans le même dossier (le bureau) pour tester.

A+