Macro pour étendre une ligne en la sélectionant

Bonjour,

Je rencontre quelques difficultés avec la mise en place d'une macro.

Objectif de la macro.

Mon but est d'étendre une case en la sélectionnant avec la sourit (par exemple pomme) jusqu'à la prochaine case qui dispose d'un texte différent (par exemple sirop) à l'aide d'une macro.

Exemple

1/ Je séléctionne la case peche, je fais la macro et ça l'étend jusqu'à la case sirop (voir l'image en pj)

2/ Je séléctionne la date 25/12/2019, je fais la macro et ça l'étend jusqu'à la case 30/12/2019

J'espère avoir été assez clair ?

Je vous remercie en tout cas pour votre aide et à bientôt

Bonjour,

Voici une proposition à tester

Pour étudier le sujet, c'est toujours mieux de joindre un fichier !

Un double-clic sur une valeur étend jusqu'à la valeur du dessous.

Pour la dernière valeur de la colonne, ce n'est pas géré, bien entendu !

Bonne journée

Bouben

Pour la prochaine fois, merci de penser au fichier joint

En PJ, la proposition, cadeau !

Bouben

Bonjour à tous,

Une autre proposition.

Double-cliquer sur la cellule à recopier vers le bas.

Le code se met dans le module de la feuille concernée.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Count <> 1 Then Exit Sub
   If Target.Row = 1 Or Target.Column > 3 Then Exit Sub
   If Len(Target) = "" Then Exit Sub
   If Cells(Rows.Count, Target.Column).End(xlUp).Row = Target.Row Then If Len(Cells(Rows.Count, Target.Column)) = 0 Then Exit Sub
   Cancel = True
   Target.Copy Range(Target, Target.End(xlDown).Offset(-1))
End Sub

Re

Si vous voulez recopier juste en sélectionnant la cellule alors remplacez le code précédent par:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Count <> 1 Then Exit Sub
   If Target.Row = 1 Or Target.Column > 3 Then Exit Sub
   If Len(Target) = "" Then Exit Sub
   If Cells(Rows.Count, Target.Column).End(xlUp).Row = Target.Row Then If Len(Cells(Rows.Count, Target.Column)) = 0 Then Exit Sub
   Target.Copy Range(Target, Target.End(xlDown).Offset(-1))
End Sub

A mon avis, c'est plus dangereux.