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, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

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

Notez que le code évalue la formule matricielle =SOMME(N($A$1:$A$10=$D$15:$D$24))

A+

 

[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]

Mais encore ?

 

[Daligault Patrick]

Bonjour
Merci de votre réponse.
Je suis novice en VBA. J'ai mis le code dans la feuille et il apparait le message ""Erreur de compilation - Attendu : numéro de ligne ou étiquette ou instruction ou fin instruction", et ""Then"" s'inscrit sur un fond bleu. Il y a une erreur ou une omission de ma part.
J'ai mis le code :

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

 

[job75]

Vous n'avez pas copié mon code correctement, il faut un espace devant le tiret bas...

 

[Daligault Patrick]

OK je mets et vous dis

 

[Daligault Patrick]

Effectivement plus aucun message d'erreur ne s'affiche.
Par contre j'ai cliqué , double cliqué, droit et gauche, mais rien ne se produit.
Une omission de ma part mais laquelle.

 

[job75]

Vous avez testé le fichier de mon post #2 ?
Si vous voulez qu'on vous aide déposez votre fichier !

 

[Daligault Patrick]

Voila

 

[job75]

Au post #2 j'ai écrit :

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code)

Or vous avez mis la macro dans un module standard (Module2) !!!

Votre fichier en retour.

 

[Daligault Patrick]

Cela a fonctionné. Un simple clic a copié la cellule source dans la cellule de destination, et seule 4 cellules ont été copiées.
Mais quand j'ai supprimé le contenu d'une cellule de destination, et fait un nouveau clic sur la cellule source correspondante une nouvelle copie ne s'est pas produite.
Pour que le système soit parfait il faudrait qu'un clic sur la cellule source :
*la copie si la cellule de destination est vide
*supprime le contenu de la cellule destination si elle n'est pas vide
Que ces effets se reproduisent si de nouveau clics sont effectués.

 

[job75]

Mais quand j'ai supprimé le contenu d'une cellule de destination, et fait un nouveau clic sur la cellule source correspondante une nouvelle copie ne s'est pas produite.

Chez moi si, vous avez mal testé. Plus que laborieux ce fil !

 

[Daligault Patrick]

Cela a fonctionné. Un simple clic a copié la cellule source dans la cellule de destination, et seule 4 cellules ont été copiées.
Mais quand j'ai supprimé le contenu d'une cellule de destination, et fait un nouveau clic sur la cellule source correspondante une nouvelle copie ne s'est pas produite.
Pour que le système soit parfait il faudrait qu'un clic sur la cellule source :
*la copie si la cellule de destination est vide
*supprime le contenu de la cellule destination si elle n'est pas vide
Que ces effets se reproduisent si de nouveau clics sont effectués.

 

[Daligault Patrick]

J'ai fait un nouveau fichier et là cela fonctionne : la suppression du contenu de cellules de destination permet de nouvelles sélections.
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?