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

[chatblanc]

Bonjour,

Je cherche une solution: pour copier la valeur d'une cellule de la colonne B de la feuille 2 vers la cellule B7 de la feuille 1 , en selectionnant une case de la colonne B et valider l'action juste par la touche entrée.

Ci-joint un fichier

Merci pour votre aide.

 

[david84]

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

Bonjour,
peut-être comme ceci (à placer dans le code de la feuille 2) :

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

A+

 

[job75]

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

Bonjour chatblanc, salut David

Dans le code de Feuil2 (clic droit sur l'onglet et Visualiser le code) :

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

Fichier joint.

A+

 

[job75]

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

Re,

En toute logique il faut ajouter cette macro, toujours en Feuil2 :

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

Fichier(2)

A+

 

[job75]

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

Re,

Pour être complet il faut tenir compte de l'activation/désactivation du classeur.

Finalement mettre dans le code de Feuil2 :

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

Et mettre dans ThisWorkbook :

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

Fichier (3).

Nota : oublié de signaler que pour tester il faut d'abord télécharger le fichier.

A+