Copie automatique de cellules par clics

[Daligault Patrick]

Bonjour

Je souhaiterais que par un clic sur une cellule d'une plage, il soit copié la valeur de cette cellule (sans la fonction) dans la cellule d'une autre plage de la même feuille, et que cette opération puisse se répéter au plus pour 4 cellules .
Par exemple sur la plage A1:A10, il est cliqué sur A2, sa valeur est alors copiée en D15, A5 en D18, A4en D17, A7 en D20. S'il est cliqué sur une 5ème cellule de la plage A1:A10 rien ne se produit.

Merci

Patrick

 

[job75]

Bonjour Daligault Patrick, le forum,

Serait-il possible d'obtenir la suppression du contenu des cellules de destination par nouveau clic sur les cellules source déjà sélectionnées?

Avec le clic droit :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim source As Range, dest As Range
Set source = [A1:A100]
Set dest = [D15:D114]
If Not Intersect(ActiveCell, source) Is Nothing And _
   Evaluate("SUM((" & source.Address & "<>"""")*(" & source.Address & "=" & dest.Address & "))") < 4 _
     Then dest(ActiveCell.Row - source.Row + 1, 1) = ActiveCell
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim source As Range, dest As Range, r As Range
Set source = [A1:A100]
Set dest = [D15:D114]
Set r = Intersect(Target, source)
If r Is Nothing Then Exit Sub
Cancel = True
For Each r In r 'si sélection multiple
    dest(r.Row - source.Row + 1) = ""
Next
End Sub

Nota : j'ai compris que la macro SelectionChange fonctionnait mal chez vous à cause des cellules vides de la plage source.

J'ai donc complété le test Evaluate.

Fichier joint.

Bonne journée.

 

[Daligault Patrick]

Cela fonctionne parfaitement.
Un grand merci à vous.
Bonne journée