Si une cellule change : copier/coller puis mise à jour

Bonjour à tous !

Je débute un peu en VBA et je n'arrive pas à faire les 2 actions requises à partir d'une seule condition.

Mon problème n'est pas compliqué :

Si la valeur dans la colonne "E" change :

1) copier/coller la valeur en "H" vers "I"

2) mettre dans la colonne "H" la date du jour

Pour l'instant j'ai que la 2ème étape avec ce code :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'Updated by Extendoffice 2017/10/12

Dim xRg As Range, xCell As Range

On Error Resume Next

If (Target.Count = 1) Then

If (Not Application.Intersect(Target, Me.Range("E:E")) Is Nothing) Then _

Target.Offset(0, 3) = Date

Application.EnableEvents = False

Set xRg = Application.Intersect(Target.Dependents, Me.Range("E:E"))

If (Not xRg Is Nothing) Then

For Each xCell In xRg

xCell.Offset(0, 3) = Date

Next

End If

Application.EnableEvents = True

End If

End Sub

merci d'avance !

Bonjour,

Teste comme ceci

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  'Updated by Extendoffice 2017/10/12
  Dim xRg As Range, xCell As Range
  On Error Resume Next
    If (Target.Count = 1) Then
      If (Not Application.Intersect(Target, Range("E:E")) Is Nothing) Then _
        Target.Offset(0, 4) = Target.Offset(0, 3): Target.Offset(0, 3) = Date
        Application.EnableEvents = False
      Set xRg = Application.Intersect(Target.Dependents, Me.Range("E:E"))
      If (Not xRg Is Nothing) Then
        For Each xCell In xRg
          xCell.Offset(0, 3) = Date
        Next
      End If
    Application.EnableEvents = True
  End If
End Sub

Merci beaucoup c'est parfait !

bonne journée !