Copie d'une donnée après validation par entree

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B8")) Is Nothing Then
    Sheets("Feuil1").[B7] = Target.Offset(-1, 0).Value
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing _
  Or Target.Count > 1 Or Target.Cells(1, 1) = "" Then
  Application.OnKey "~"
  Application.OnKey "{ENTER}" 'pavé numérique
Else
  Application.OnKey "~", "Feuil2.Valide" 'Feuil2=> CodeName
  Application.OnKey "{ENTER}", "Feuil2.Valide"
End If
End Sub

Private Sub Valide()
Feuil1.[B7] = ActiveCell 'Feuil1=> CodeName
ActiveCell.Offset(1).Select 'facultatif, décale la sélection
End Sub

Private Sub Worksheet_Deactivate()
Application.OnKey "~"
Application.OnKey "{ENTER}" 'pavé numérique
End Sub

Private Sub Worksheet_Activate()
Dim s As Range
ActiveCell.Activate: Set s = Selection
Application.ScreenUpdating = False: [A1].Select: s.Select
End Sub

Private Sub Worksheet_Deactivate()
Application.OnKey "~"
Application.OnKey "{ENTER}" 'pavé numérique
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing _
  Or Target.Count > 1 Or ActiveCell = "" Then
  Application.OnKey "~"
  Application.OnKey "{ENTER}"
Else
  Application.OnKey "~", "Feuil2.Valide" 'Feuil2=> CodeName
  Application.OnKey "{ENTER}", "Feuil2.Valide"
End If
End Sub

Private Sub Valide()
Feuil1.[B7] = ActiveCell 'Feuil1=> CodeName
If ActiveCell.Row < 65536 Then ActiveCell.Offset(1).Select 'facultatif, décale la sélection
End Sub

Private Sub Workbook_Activate()
If ActiveSheet.CodeName <> "Feuil2" Then Exit Sub
Dim s As Range
ActiveCell.Activate: Set s = Selection
Application.ScreenUpdating = False: [A1].Select: s.Select
End Sub

Private Sub Workbook_Deactivate()
Application.OnKey "~"
Application.OnKey "{ENTER}"
End Sub