Copier la cellule active

bonjour,

dans le fichier join, je copie les cellules qui change dans deux autre tableaux plus bas selon des dates de saisie pour calculer une moyenne j'utilise le code vba suivant qui est dans thisworkbook: mais il me copie plusieurs fois les cellules? j'aimerais qu'il me copie une seule fois la cellule qui change, merci

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Target.Select
x = ActiveCell.Row
y = ActiveCell.Column

If Not Intersect(Target, Cells(x, y)) Is Nothing Then

       If Now() >= Range("b2") And Now() <= Range("b3") Then
          Cells(x + 39, y) = ActiveCell.Value

       End If
       If Now() >= Range("b5") And Now() <= Range("b6") Then
          Cells(x + 66, y) = ActiveCell.Value
       End If

End If
Target.Select
End Sub

pascb423 a écrit :

bonjour

essaie en désactivant le déclenchement des évènements. voir proposition ci-dessous.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Target.Select
x = ActiveCell.Row
y = ActiveCell.Column
application.enableevents=false
If Not Intersect(Target, Cells(x, y)) Is Nothing Then

       If Now() >= Range("b2") And Now() <= Range("b3") Then
          Cells(x + 39, y) = ActiveCell.Value

       End If
       If Now() >= Range("b5") And Now() <= Range("b6") Then
          Cells(x + 66, y) = ActiveCell.Value
       End If

End If
Target.Select
application.enableevents=true
End Sub

merci, c'est bôn, ca marche, merci encore