double clic copie et colle valeure d'une cellule

[olivemotard]

Bonjour a tous

De retour sur le forum!
Enfin.... J'ai retrouvé un taf alors je me remets a excel
Et j'ai encore besoin de vous

Je souhaite créer quelque chose d'a priori simple, mais j'ai perdu un peu et je dois ecrire ça comme un cochon*

Je souhaite >>

Lorsqu'on double clic dans une cellule, copier la valeure des deux cellules qui se trouvent a droite.
Changer de feuille, coller (collage special valeure) dans la premiere ligne vide.
Et afficher un message de validation.

Voici mon code pour le moment :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'copier la valeure des deux cellules a droite de celle ou on double clic

ActiveCell.Offset(0, 1)&(0, 2).Select.Value
Selection.Copy

Application.ScreenUpdating = False


'coller dans la premiere ligne vide

i = 1
Sheets("Feuil2").Select
While Not Range("A" & i & "").Value = ""
i = i + 1
Wend

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.ScreenUpdating = True

messagebox = "ajouté à la commande"


End Sub

Merci d'avance a tous

 

[Pierrot93]

Re : double clic copie et colle valeure d'une cellule

Bonjour,

si j'ai bien compris :

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheets("Feuil2").Range("A65536").End(xlUp)(2).Resize(, 2).Value = Target.Offset(0, 1).Resize(, 2).Value
Cancel = True
MsgBox "copie faite !!!"
End Sub

bon après midi
@+

 

[JORDAN]

Re : double clic copie et colle valeure d'une cellule

Bonjour,

je suis en retard pour répondre!!!

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer

'copier la valeure des deux cellules a droite de celle ou on double clic

Target.Offset(0, 1).Resize(2, 1).Select
Selection.Copy

Application.ScreenUpdating = False


'coller dans la premiere ligne vide

i = 1
Sheets("Feuil2").Select
While Not Range("A" & i & "").Value = ""
i = i + 1
Wend

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.ScreenUpdating = True

MsgBox "ajouté à la commande"


End Sub

 

[olivemotard]

Re : double clic copie et colle valeure d'une cellule

Bonjour a tous....

Merci pour votre aide, j'ai adapté a mon fichier et voila ce que cela donne
je double clic dans une cellule, cela copie les deux cellules a droite, me demande si je veux ajouter, puis colle dans mon bon de commande.

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer

Sheets("Feuil2").Select
ActiveSheet.Unprotect

Application.DisplayStatusBar = True
Application.StatusBar = "Traitement en cours..."


'copier la valeure des deux cellules a droite de celle ou on double clic

Target.Offset(0, 1).Resize(1, 2).Select
Selection.Copy

Application.ScreenUpdating = False

If MsgBox("Ajouter a la commande ?", vbYesNo) = vbYes Then



'coller dans la premiere ligne vide

Sheets("Feuil2").Range("A65536").End(xlUp)(2).Resize(, 2).Value = Target.Offset(0, 1).Resize(, 2).Value
Cancel = True


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Else
' il a cliqué sur Non
End If

Application.ScreenUpdating = True


Application.DisplayStatusBar = False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True


End Sub

Bonne journée a tous et encore merci