Mise à jour bidirectionnelle de cellules localisées sur différentes feuilles

  • Initiateur de la discussion Initiateur de la discussion GCAS
  • Date de début Date de début

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 !

GCAS

XLDnaute Nouveau
Bonjour,

Voici ce que je souhaite faire :
1. Encoder E2 (dans feuille1 ou bien feuille2 ou bien feuille 3) en choisisant une valeur dans la liste déroulante
2. Mettre à jour automatiquement E2 dans les 2 autres feuilles avec la même valeur

Je pense qu'il est indispensable de passer par VBA...

Dans le code VBA, je souhaiterais utiliser le nom des cellules (profil_client_pv, profil_client_ces et profil_client_ch).

Merci d'avance pour votre aide.

gcas
 

Pièces jointes

Re : Mise à jour bidirectionnelle de cellules localisées sur différentes feuilles

Bonsoir gcas, le forum,

Il faut en effet une macro, par exemple celle-ci dans ThisWorkbook :

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Application.EnableEvents = False
If Sh.Name = [profil_client_pv].Parent.Name Then
  If Not Intersect(Source, [profil_client_pv]) Is Nothing Then
    [profil_client_ces] = [profil_client_pv]
    [profil_client_ch] = [profil_client_pv]
  End If
ElseIf Sh.Name = [profil_client_ces].Parent.Name Then
  If Not Intersect(Source, [profil_client_ces]) Is Nothing Then
    [profil_client_pv] = [profil_client_ces]
    [profil_client_ch] = [profil_client_ces]
  End If
ElseIf Sh.Name = [profil_client_ch].Parent.Name Then
  If Not Intersect(Source, [profil_client_ch]) Is Nothing Then
    [profil_client_pv] = [profil_client_ch]
    [profil_client_ces] = [profil_client_ch]
  End If
End If
Application.EnableEvents = True
End Sub
Il y a peut-être plus simple.

Fichier .xls joint.

A+
 

Pièces jointes

Re : Mise à jour bidirectionnelle de cellules localisées sur différentes feuilles

Re,

A priori on peut simplifier en supprimant 3 des tests :

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Application.EnableEvents = False
If Sh.Name = [profil_client_pv].Parent.Name Then
  [profil_client_ces] = [profil_client_pv]
  [profil_client_ch] = [profil_client_pv]
ElseIf Sh.Name = [profil_client_ces].Parent.Name Then
  [profil_client_pv] = [profil_client_ces]
  [profil_client_ch] = [profil_client_ces]
ElseIf Sh.Name = [profil_client_ch].Parent.Name Then
  [profil_client_pv] = [profil_client_ch]
  [profil_client_ces] = [profil_client_ch]
End If
Application.EnableEvents = True
End Sub
Fichier (2).

A+
 

Pièces jointes

Re : Mise à jour bidirectionnelle de cellules localisées sur différentes feuilles

Re,

Autre solution :

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim n$, n1$, n2$, n3$
n = Sh.Name
n1 = [profil_client_pv].Parent.Name
n2 = [profil_client_ces].Parent.Name
n3 = [profil_client_ch].Parent.Name
If Source.Address = "$E$2" And (n = n1 Or n = n2 Or n = n3) Then
  Application.EnableEvents = False
  [profil_client_pv] = Source
  [profil_client_ces] = Source
  [profil_client_ch] = Source
  Application.EnableEvents = True
End If
End Sub
Mais ce n'est pas tout à fait la même chose (si modification simultanée de plusieurs cellules).

Fichier (3).

A+
 

Pièces jointes

Dernière édition:
Re : Mise à jour bidirectionnelle de cellules localisées sur différentes feuilles

Re,

La solution précédente ne va pas car les 3 cellules ne seront pas forcément toujours en E2.

Voici la solution la meilleure car la plus simple :

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim cible As Range
On Error Resume Next
Set cible = Intersect(Source, [profil_client_pv])
Set cible = Intersect(Source, [profil_client_ces])
Set cible = Intersect(Source, [profil_client_ch])
Application.EnableEvents = False
[profil_client_pv] = cible
[profil_client_ces] = cible
[profil_client_ch] = cible
Application.EnableEvents = True
End Sub
Par contre elle n'est pas très facile à comprendre...

Fichier (4).

A+
 

Pièces jointes

- 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

Discussions similaires

Réponses
24
Affichages
2 K
Retour