Copier coller before doubleclic

Bonjour,

Un petit probleme de copier coller before double click.

Un double click dans une des cellules de la zone H2:AL100 sur la feuille 1

1/Ouvre un MsgBox "Copier valeurs?" Option Yes /No

Si Yes:

2/ fermer le msgbox et copier les values des colonnes A:E de la ligne active vers la feuille 2 Cellules A1 a E1.

Si No: fermer le MsgBox

Probleme: Cette operation doit s'integrer dans une procedure WorkSheet_BeforeDoubleClick deja existante pour cette page donc avec du IF...THEN...ELSE.

Le reste du code de cette feuille est:

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

Dim xRg As Range, leJourDebut As Date

'Si on ne double-clique pas sur la colonne G, on regarde si on a double-cliqué

' sur la 1ière ligne du diagramme

If Target.Column = Range("G1").Column Then

'Si la valeur de la cellule n'est pas 'Done', on ne fait rien

If LCase(Target) <> "done" Then Exit Sub

'Si on a double-cliqué sur la ligne 1, on ne fait rien

If Target.Row = 1 Then Exit Sub

'on annule l'action normal du double -clique

Cancel = True

' recherche de la dernière cellule non vide

Set xRg = Cells(Rows.Count, 1).End(xlUp)

' la 1ière cellule vide est une ligne plus bas

Set xRg = xRg.Offset(1, 0)

' copy de la ligne à la 1ière ligne vide

Range(Cells(Target.Row, "A"), Cells(Target.Row, "G")).Copy Destination:=xRg

' détermination de la date programmée

Cells(xRg.Row, "D") = Cells(Target.Row, "F")

' détermination de la date de la prochaine MP

Cells(xRg.Row, "F") = Cells(xRg.Row, "D") + Cells(xRg.Row, "E")

' effacement de la valeur 'Done'

Cells(xRg.Row, "G").ClearContents

ElseIf Target.Column >= Range("H1").Column And Target.Row = 1 Then

' on a double-cliqué sur la 1ière ligne du diagramme

Cancel = True

MsgBox ("Changement de la date de début du diagramme")

leJourDebut = FormCal.Calendrier

If leJourDebut = 0 Then Exit Sub

Range("H1") = leJourDebut

Else

End If

End Sub

Merci pour votre aide.

Zeuf

Bonjour,

Le code dans l'évènement n'est pas fort...

Remplace la procédure par..

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xRg As Range, leJourDebut As Date
    If Not Intersect(Target, Range("H2:AL100")) Is Nothing Then
        If MsgBox("Copier valeur", vbQuestion + vbYesNo) = vbYes Then
            'Copier ????????????????
            Stop
        Else
            Cancel = True
            Exit Sub
        End If
    End If

'Si on ne double-clique pas sur la colonne G, on regarde si on a double-cliqué
' sur la 1ière ligne du diagramme
    If Target.Column = Range("G1").Column Then
        'Si la valeur de la cellule n'est pas 'Done', on ne fait rien
        If LCase(Target) <> "done" Then Exit Sub
        'Si on a double-cliqué sur la ligne 1, on ne fait rien
        If Target.Row = 1 Then Exit Sub
        'on annule l'action normal du double -clique
        Cancel = True
        ' recherche de la dernière cellule non vide
        Set xRg = Cells(Rows.Count, 1).End(xlUp)
        ' la 1ière cellule vide est une ligne plus bas
        Set xRg = xRg.Offset(1, 0)
        ' copy de la ligne à la 1ière ligne vide
        Range(Cells(Target.Row, "A"), Cells(Target.Row, "G")).Copy Destination:=xRg
        ' détermination de la date programmée
        Cells(xRg.Row, "D") = Cells(Target.Row, "F")
        ' détermination de la date de la prochaine MP
        Cells(xRg.Row, "F") = Cells(xRg.Row, "D") + Cells(xRg.Row, "E")
        ' effacement de la valeur 'Done'
        Cells(xRg.Row, "G").ClearContents

    ElseIf Target.Column >= Range("H1").Column And Target.Row = 1 Then
        ' on a double-cliqué sur la 1ière ligne du diagramme
        Cancel = True
        MsgBox ("Changement de la date de début du diagramme")
        leJourDebut = FormCal.Calendrier
        If leJourDebut = 0 Then Exit Sub
        Range("H1") = leJourDebut
    End If
End Sub

Pour copier tu donne pas assez d'info.

A+