Discussion :

[tibiscuit]

Bonjour,

Je souhaiterais pouvoir lier le contenu des cellules de 2 feuilles réciproquement entre elles, c'est à dire qu'une modification sur une feuille s'affiche également sur l'autre. J'ai testé quelques bouts de code mais soit je génère une boucle infinie, soit ca na marche tout simplement pas.
Une solution?

Cordialement

[jfontaine]

Bonjour,

Une solution est tester la feuille active

sur la premiere feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Address(False, False) = "A1" Then
    If ActiveSheet.Name = Me.Name Then Sheets("Feuil2").Range("A1") = Target.Value
End If
 
End Sub

Sur la deuxieme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Address(False, False) = "A1" Then
    If ActiveSheet.Name = Me.Name Then Sheets("Feuil1").Range("A1") = Target.Value
End If
 
End Sub

[tibiscuit]

Merci de ta réponse rapide, cependant comment l'adapter pour que cela fonction sur toute les cellules de la feuille et pas seulement sur A1?

[jfontaine]

Comme cela

C'est encore plus court

Feuil 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
 
If ActiveSheet.Name = Me.Name Then Sheets("Feuil2").Range(Target.Address) = Target.Value
 
End Sub

Feuil 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
 
If ActiveSheet.Name = Me.Name Then Sheets("Feuil1").Range(Target.Address) = Target.Value
 
End Sub

[tibiscuit]

Désolé, ça ne fonctionne pas

[jfontaine]

J'ai complété la proposition de mon précédent post

[jfontaine]

Tu es sous quelle version d'excel (ici 2003)

[tibiscuit]

2010.
Tu penses que ça change quelque chose?

[jfontaine]

As tu activé les macros

[tibiscuit]

Oui

[mercatog]

Bonsoir
Peut être que les évènements sont désactivés. Pour les réactiver, lance cette macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub ActiveEvents()
    Application.EnableEvents = True
End Sub

Ensuite une proposition à mettre dans le module ThisWorkbook

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShName As String
Dim k As Integer
 
If InStr("Feuil1|Feuil2|Recap", Sh.Name) > 0 Then
    ShName = "Recap"
    If Sh.Name = "Recap" Then
        If Target.Column <= 4 Then
            ShName = "Feuil1"
        ElseIf Target.Column <= 8 Then
            ShName = "Feuil2"
            k = -4
        End If
    ElseIf Sh.Name = "Feuil2" Then
        k = 4
    End If
    On Error Resume Next
    Application.EnableEvents = False
    Sheets(ShName).Range(Target.Offset(0, k).Address).Value = Target.Value
    Application.EnableEvents = True
End If
End Sub