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

Guest

Pierrot93

XLDnaute Barbatruc

JORDAN

XLDnaute Impliqué

olivemotard

Guest

Discussions similaires

double clic copie et colle valeure d'une cellule

olivemotard

Guest

Pierrot93

XLDnaute Barbatruc

JORDAN

XLDnaute Impliqué

olivemotard

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency