DoubleClick range sous bouton

[Temjeh]

Bonsoir à tous

Quelques fois je répond mais là je cherche

Avec un commandbutton je sélectionne un range. Est-ce possible de lui faire doublecliquer dans le range pour partir le code dans le doubleclic du range car si je copie le code directement sous le bouton ca ne fonctionne pas:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 3 Then
Target.EntireRow.Copy
Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Target.Activate
Else

Temjeh ... merci

 

[MichelXld]

bonjour cher Temjeh

tu peux aussi intégrer la procedure directement à la suite dans le CommandButton en remplaçant l'argument Target par le nom de la cellule

par exemle

Private Sub CommandButton1_Click()
'
'debut procedure
'
Range('A3').EntireRow.Copy
Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
End Sub


bonne journée
MichelXld

 

[Temjeh]

Merci beaucoup Michel

J'avais effectivement trouvé mais le prob est que contrairement a target après avoir copier/coller les données l'activecell se retrouve en bas à la suite alors que je veux quelle reste dans ma cell de départ pour continuer à examiné ma liste pour isolé des lignes(sinon si je copie la ligne 22 ...il paste à ligne 1000 je doit remonter le scroll manuel à la ligne 22 pour continuer mon examen de ligne).

Si il y a une solution:

Selection.EntireRow.Copy
Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'ici revient à ma sélection du départ

Merci beaucoup

Temjeh

 

[MichelXld]

rebonjour


sinon tu peux tester cette adaptation


Private Sub CommandButton1_Click()
Dim maCellule As Range
'
'debut procedure
'
Set maCellule = ActiveCell

maCellule.EntireRow.Copy
Range('A65536').End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
maCellule.Activate
End Sub


bonne journée
MichelXld

 

[Temjeh]

Merci beaucoup pour ce beau code

Désolé si je prend du temps ...ici à montréal il y a 6hrs de décalage avec la france. Je post souvent le soir et je vérifie souvent mes réponses la nuit.

A+

Temjeh