Double-clic qui permet de copier des cellules

[vdh_xavier]

Bonjour,

J’explique rapidement ma feuille excel :
Dans la feuille appelée Feuil1, dans les cellules des colonnes G et H, j’ai des dates dans le format « 01/01/12 » et les cellules des colonnes D et E sont vides.

Quelqu’un connaît-il une fonction qui permette que si je fais un double-clic dans une cellule de la colonne H (de H3 à H90000), les valeurs de G3 et de H3 aillent se copier en D3 et E3 ET qu’en G3 et H3 viennent se mettre les mêmes dates qu’auparavant, incrémentées d’un an.

Exemple : AVANT
D3 E3 G3 H3
Vide vide 12/05/10 11/05/11
APRES
D3 E3 G3 H3
12/05/10 11/05/11 12/05/11 11/05/12

Merci d’avance pour votre aide

 

[Grand Chaman Excel]

Re : Double-clic qui permet de copier des cellules

Bonjour vdh_xavier,

À essayer, voici un code à mettre dans ta Feuil1 :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("H3:H9000")) Is Nothing Then
        Target.Offset(0, -1).Resize(1, 2).Copy Target.Offset(0, -4)
        Target.Offset(0, -1) = DateSerial(Year(Target.Offset(0, -1)) + 1, Month(Target.Offset(0, -1)), Day(Target.Offset(0, -1)))
        Target = DateSerial(Year(Target) + 1, Month(Target), Day(Target))
        Cancel = True
    End If
End Sub

A+

 

[vdh_xavier]

Re : Double-clic qui permet de copier des cellules

Merci beaucoup pour votre réponse, mais j'ai un problème : Vu qu'il y a des données en H3, lorsque je double-clique dessus, j'entre dans la cellule pour modifier sa valeur.

Que faire? Faut-il ajouter une nouvelle colonne?

Bien à vous

 

[Grand Chaman Excel]

Re : Double-clic qui permet de copier des cellules

Bonjour,
Le code fonctionne correctement dès que tu double-cliques dans une cellule... mais est-ce que tu copié le code dans ta "FEUIL1" comme j'ai indiqué? Il ne faut pas qu'il soit dans un "MODULE1".
Pour le savoir, va dans l'éditeur VBA (ALT + F11).
Dans l'arborescence à gauche, ouvre ton projet et double clique sur Feuil1 (sous Microsoft Excel Objects).
Copie le code dans la feuille blanche à droite après avoir double cliquer sur "Feuil1")

 

[vdh_xavier]

Re : Double-clic qui permet de copier des cellules

Oui j'ai bien copié le code comme indiqué.

Je me permets de joindre mon fichier.

Merci de bien vouloir y jeter un coup d'oeil et encore merci beaucoup pour votre aide.

 

[bruno 9442]

Re : Double-clic qui permet de copier des cellules

Bonsoir vdh_xavier, Grand Chaman Excel et le forum.
Comme la bien marquer Grand Chaman Excel :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
et non pas :
Private Sub Worksheet_BeforeTripleClick(ByVal Target As Range, Cancel As Boolean)
Un simple copier coller .
Bonne soirée

 

[Grand Chaman Excel]

Re : Double-clic qui permet de copier des cellules

Bonjour,
Si tu as bien copié le code que j'ai mis, alors pourquoi c'est :

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

au lieu de

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

😕

BeforeTripleClick, ça n'existe pas !!!

À corriger et retester.

 

[vdh_xavier]

Re : Double-clic qui permet de copier des cellules

Mea culpa, j'avais changé cela dans un premier temps, voyant que ça ne fonctionnait pas.

Tout fonctionne parfaitement maintenant.

Merci à toi Grand Chaman et merci également à bruno d'être intervenu.

 

[vdh_xavier]

Re : Double-clic qui permet de copier des cellules

Encore un petite question :

J'ai un petit peu modifié le code car c'était plus pratique pour moi (j'ai tout décalé d'une colonne, rien de plus) et tout fonctionne très bien.

Mon problème est que lors de la copie, l'arrière fond rouge est également copié en E3, or je souhaite qu'il soit blanc.

J'ai ajouté quelque chose au code, mais ça ne fonctionne pas.

Voici le code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("I3:I9999")) Is Nothing Then
Target.Offset(0, -2).Resize(1, 2).Copy Target.Offset(0, -5)
Target.Offset(0, -2) = DateSerial(Year(Target.Offset(0, -2)) + 1, Month(Target.Offset(0, -2)), Day(Target.Offset(0, -2)))
Target.Offset(0, -1) = DateSerial(Year(Target.Offset(0, -1)) + 1, Month(Target.Offset(0, -1)), Day(Target.Offset(0, -1)))
Cancel = True

Target.Offset(0, -4).Select
With Selection.Interior
.Pattern = xlSolid
.Color = 65535
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End If
End Sub


Pouvez-vous me dire où est mon erreur?

D'avance merci

 

[kjin]

Re : Double-clic qui permet de copier des cellules

Pouvez-vous me dire où est mon erreur?

Un quadruple_click peut être...😉

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 8 Or Target.Row < 3 Then Exit Sub
If IsDate(Target) Then
    Cancel = True
    Target.Offset(0, -4) = Target.Offset(0, -1)
    Target.Offset(0, -3) = Target
    Target.Offset(0, -1) = DateSerial(Year(Target.Offset(0, -1)) + 1, Month(Target.Offset(0, -1)), Day(Target.Offset(0, -1)))
    Target = DateSerial(Year(Target) + 1, Month(Target), Day(Target))
End If
End Sub

A+
kjin