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

ReneDav14000

XLDnaute Occasionnel
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
 
Solution
Re,

VB:
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 :)

cp4

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Repose en paix
Bonsoir,

Dans le module de code de la feuille :
VB:
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

XLDnaute Barbatruc
Supporter XLD
Bonjour ReneDav,
un essai en PJ avec :
VB:
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
 

Pièces jointes

  • ReneDav.xlsm
    16.2 KB · Affichages: 1

ReneDav14000

XLDnaute Occasionnel
Bonsoir,

Dans le module de code de la feuille :
VB:
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

XLDnaute Occasionnel
Bonjour ReneDav,
un essai en PJ avec :
VB:
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

XLDnaute Barbatruc
Bonjour à tous,

Si l'on veut pouvoir modifier la cellule source avant le transfert il vaut mieux le double-clic :
VB:
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

XLDnaute Occasionnel
Bonjour à tous,

Si l'on veut pouvoir modifier la cellule source avant le transfert il vaut mieux le double-clic :
VB:
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

XLDnaute Barbatruc
Repose en paix
Re,

VB:
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 :)
 

Pièces jointes

  • Agenda_Heb2.xlsm
    596.2 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG