copier la cellule avec double clic

On 14 oct, 16:21, pellet15 <pelle...@videotron.ca> wrote:

On 14 oct, 12:27, isabelle <i...@v.org> wrote:









> petite remarque,
> j'ai fait le test avec Worksheet_SelectionChange
> car avec Worksheet_BeforeDoubleClick j'entre automatiquement en mode édition de cellule.

> Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>   Set sh1 = ActiveSheet
>   Set sh2 = Sheets("Feuille_insp")

>   If Intersect(Target, Range("D:D")) Is Nothing Then GoTo fin

>   sh1.Unprotect "7433304DanielPelletier15061954"
>   sh2.Unprotect "7433304DanielPelletier15061954"

>    Application.CutCopyMode = False
>    Selection.Copy Sheets("Feuille_insp").Range("H2")

>   sh1.Protect "7433304DanielPelletier15061954", DrawingObjects:=Fal se, Contents:=True, Scenarios:=True
>   sh2.Protect "7433304DanielPelletier15061954", DrawingObjects:=Fal se, Contents:=True, Scenarios:=True
> ' historique
> fin:
> End Sub

> --
> isabelle

Bonjour Isabelle

J'ai exécuter et Le message d'erreure me donne :

'' la methode copy de la classe range a échoué ''

ligne en jaune
Selection.Copy Sheets("Feuille_insp").Range("H2")

Merci

Bonsoir Isabelle

la cellule ou je copie (colonne D) contient une date et la cellule ou
je colle est fusionner avec d'autre cellule, cela peut t'il causer
problème?

merci

Tu copies le code suivant dans le haut du module de la feuille où tu veux
effectuer tes doubles-clics.

La copie s'effectue seulement si le double-clic est fait dans une cellule de la
colonne D:D vers la cellule H2 de la feuille destination. La cellule de destination
peut-être fusionnée, mais attention H2 doit être l'adresse qui s'affiche dans la
section à l'extrême gauche de la barre des formules lorsque tu la sélectionnes.

'Déclaration de la variable dans le haut du module de la feuille.
Dim Rg As Range
'-------------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Gestion_Erreur As String, Data As Variant
On Error GoTo Gestion_Erreur

Me.Unprotect "7433304DanielPelletier15061954"
If Rg Is Nothing Then Set Rg = ActiveCell
If Union(Rg, Target).Column = Range("D:D").Column Then
With Sheets("Feuil2") '("Feuille_insp")
.Unprotect "7433304DanielPelletier15061954"
Data = Rg
.Range("H2") = Data
Application.CutCopyMode = False
.Protect "7433304DanielPelletier15061954"
End With
End If
Cancel = True
Rg = Selection
Me.Protect "7433304DanielPelletier15061954"
Exit Sub
Gestion_Erreur:
Me.Protect
MsgBox Err.Number & ", " & Err.Description
Exit Sub
End Sub

'-------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Rg = Selection
End Sub
'-------------------------------------------------------------------------------


MichD
------------------------------------------

Dans la procédure "Worksheet_BeforeDoubleClick"
Tu peux éliminer cette ligne de code, elle a été oubliée :

| Application.CutCopyMode = False


'Déclaration de la variable dans le haut du module de la feuille.
Dim Rg As Range
'-------------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Gestion_Erreur As String, Data As Variant
On Error GoTo Gestion_Erreur

Me.Unprotect "7433304DanielPelletier15061954"
If Rg Is Nothing Then Set Rg = ActiveCell
If Union(Rg, Target).Column = Range("D:D").Column Then
With Sheets("Feuil2") '("Feuille_insp")
.Unprotect "7433304DanielPelletier15061954"
Data = Rg
.Range("H2") = Data
.Protect "7433304DanielPelletier15061954"
End With
End If
Cancel = True
Rg = Selection
Me.Protect "7433304DanielPelletier15061954"
Exit Sub
Gestion_Erreur:
Me.Protect
MsgBox Err.Number & ", " & Err.Description
Exit Sub
End Sub

'-------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Rg = Selection
End Sub
'-------------------------------------------------------------------------------


MichD
------------------------------------------