double clic copie et colle valeure d'une cellule

olivemotard · 16 Avril 2010

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 · 16 Avril 2010

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

Bonjour,

si j'ai bien compris :

Code:

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 · 16 Avril 2010

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

Bonjour,

je suis en retard pour répondre!!!

Code:

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 · 19 Avril 2010

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

double clic copie et colle valeure d'une cellule

olivemotard

XLDnaute Junior

Pierrot93

XLDnaute Barbatruc

JORDAN

XLDnaute Impliqué

olivemotard

XLDnaute Junior

Discussions similaires