XL 2016 Copier le contenu d'une cellule en cliquant dessus

[ReneDav14000]

Bonjour à tous,
Je cherche à faire un truc tout bête mais je n'y arrive.
Voilà dans les cellules (C5;K5;AA5;AI5;AQ5; C14;K14;AA14;AI14;AQ14) il y a une donnée.
Je souhaiterai qu'en cliquant sur une de ces cellules, elle soit copiée en B26.
Par exemple : Je clique sur C5 alors le contenu de C5 est copié en B26. Ensuite, je clique sur AQ14 alors B26 est effacée et prends la valeur de AQ14.
Merci par avance pour votre aide

 

[cp4]

Bonjour à tous,
Je cherche à faire un truc tout bête mais je n'y arrive.
Voilà dans les cellules (C5;K5;AA5;AI5;AQ5; C14;K14;AA14;AI14;AQ14) il y a une donnée.
Je souhaiterai qu'en cliquant sur une de ces cellules, elle soit copiée en B26.
Par exemple : Je clique sur C5 alors le contenu de C5 est copié en B26. Ensuite, je clique sur AQ14 alors B26 est effacée et prends la valeur de AQ14.
Merci par avance pour votre aide

Bonjour,

Un fichier STP.

 

[Hasco]

Bonsoir,

Dans le module de code de la feuille :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 And _
       Not IsEmpty(Target) And _
       Not Intersect(Target, Range("C5,K5,AA5,AI5,AQ5, C14,K14,AA14,AI14,AQ14")) Is Nothing Then
        Range("B26").Value = Target.Value
    End If
End Sub

Si la cellule cliquée est vide que faut-il faire ? Ici rien n'est fait

 

[sylvanu]

Bonjour ReneDav,
un essai en PJ avec :

Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C5,K5,AA5,AI5,AQ5,C14,K14,AA14,AI14,AQ14]) Is Nothing Then
        [B26] = Target
    End If
Fin:
End Sub

 

[ReneDav14000]

Bonsoir,

Dans le module de code de la feuille :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 And _
       Not IsEmpty(Target) And _
       Not Intersect(Target, Range("C5,K5,AA5,AI5,AQ5, C14,K14,AA14,AI14,AQ14")) Is Nothing Then
        Range("B26").Value = Target.Value
    End If
End Sub

Si la cellule cliquée est vide que faut-il faire ? Ici rien n'est fait

Bonjour Hasco,
La cellule cliquée ne sera jamais vide.
Merci pour ton code

 

[ReneDav14000]

Bonjour ReneDav,
un essai en PJ avec :

Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C5,K5,AA5,AI5,AQ5,C14,K14,AA14,AI14,AQ14]) Is Nothing Then
        [B26] = Target
    End If
Fin:
End Sub

Bonjour Sylvanu,
Ton code et celui d'Hasco fonctionnent très bien merci beaucoup.
Par contre, ça ne fonctionne plus si je fusionne les cellules, mais bon c'est un détail.
Encore merci à vous deux.

 

[job75]

Bonjour à tous,

Si l'on veut pouvoir modifier la cellule source avant le transfert il vaut mieux le double-clic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(ActiveCell, [C5,K5,AA5,AI5,AQ5,C14,K14,AA14,AI14,AQ14]) Is Nothing Then Cancel = True: [B26] = ActiveCell
End Sub

A+

 

[ReneDav14000]

Bonjour à tous,

Si l'on veut pouvoir modifier la cellule source avant le transfert il vaut mieux le double-clic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(ActiveCell, [C5,K5,AA5,AI5,AQ5, C14,K14,AA14,AI14,AQ14]) Is Nothing Then Cancel = True: [B26] = ActiveCell
End Sub

A+

Bonjour job75,
Avec un seul clique, ça fonctionne bien. La cellule source, ne sera jamais changée.
Merci pour ton code

 

[Hasco]

Par contre, ça ne fonctionne plus si je fusionne les cellules,

Eh ! C'est sans doute le genre de choses, qu'on ne peut deviner et qui aurait été traité sur un fichier exemple représentatif dès le post 1

Cordialement

 

[ReneDav14000]

Eh ! C'est sans doute le genre de choses, qu'on ne peut deviner et qui aurait été traité sur un fichier exemple représentatif dès le post 1

Cordialement

Oui, je sais et je l'oubli trop souvent, le voici

 

[Hasco]

Re,

Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target(1, 1), [C5,K5,S5,AA5,AI5,AQ5,C14,K14,S14,AA14,AI14,AQ14]) Is Nothing Then
        [B24] = Target(1, 1)
    End If

End Sub

Ne mettez des On Error Goto FIN que lorsque vous aurez fini le développement de votre fichier ou pour eviter une erreur que vous connaissez à l'avance. Sinon, vous risquez de masquer des erreurs qui vous renseigneraient sur les modifications à faire.
Sachez que la notation [ ], raccourci pour Evaluate() demande plus de ressource à excel, n'en abusez pas.

Et enfin question pourquoi masquer des feuilles à la fermeture du fichier ? pour les démasquer à son ouverture ?
Le fichier étant fermé, personne ne les verra

 

[ReneDav14000]

Oui c'est certain ça ne sert à rien de cacher les feuilles à la fermeture du fichier.
Merci pour vos bons conseils et votre aide

Maintenant je vais m'atteler à remplir le tableau du dessous avec celui du dessus