Microsoft 365 copie d'une ligne automatiquement

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une belle journée,

Voici ce qui m'amène à vous solliciter à nouveau :
J'ai un super code (fait pas Patrick que je remercie à nouveau) qui me permets, quand double clic (par exemple) dans les cellules de H7 à H30) de positionner le curseur de ma souris au bout du texte existant après avoir ajouter un "-"

Toutefois, j'ai un souci
Après le double clic, il y a "exit sub" pour laisser ajouter du texte ...
Mon besoin :
Après avoir ajouté du texte et après avoir validé, je souhaite que la ligne de la cellule active soit copiée, dans la Feuil2, automatiquement (comme je le fais pour l'exemple en appuyant sur le bouton "Copy_ligne) mais sans l'utilisation du bouton.

Je n'ai pas trouvé comment faire malgré toutes mes recherches et tentatives.
Auriez-vous la solution ?
Je joins un petit fichier test.
Avec mes remerciements,
Amicalement,
lionel,

 

[Phil69970]

Bonjour usine à gaz, le forum

Essaye ceci :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:=""

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim DerLig As String

Set Sh1 = Sheets("Feuil1")
Set Sh2 = Sheets("Feuil2")

DerLig = Sh1.Range("H" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Sh1.Range("H8:H" & DerLig)) Is Nothing Then
    Target.EntireRow.Copy Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Offset(1)
End If

Set Sh1 = Nothing
Set Sh2 = Nothing

ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Code à mettre ici :

 

[Usine à gaz]

Bonjour Phil69970

Merci pour ton code.
Je le garde pour un autre besoin car il est super bon

Mais il ne répond pas pas au besoin.
Selon ma demande, il est important de garder dans un code modifié celui de Patrick qui répond précisément au besoin initial que j'avais exprimé dans un post antérieur :
"J'ai un super code (fait pas Patrick que je remercie à nouveau) qui me permets, quand double clic (par exemple) dans les cellules de H7 à H30) de positionner le curseur de ma souris au bout du texte existant après avoir ajouter un "-"'

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("h7:h30")) Is Nothing Then
    Cancel = True
    Application.EnableEvents = False
    Application.EnableEvents = False
    Target.Value = Trim(Target.Value) & IIf(Right(Trim(Target.Value), 1) = "-", " ", " - ")
    If Target.Value = " - " Then Target.Value = ""
    Application.EnableEvents = True
    CreateObject("wscript.shell").SendKeys "{F2}"    'évite la désactivation du pavé numérique
    Exit Sub
    End If
End Sub

lionel

 

[Phil69970]

Re

Peut être ce mixe peux corresponde à ce que tu veux mais pas convaincu....

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim DerLig As String

Set Sh1 = Sheets("Feuil1")
Set Sh2 = Sheets("Feuil2")

DerLig = Sh1.Range("H" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Sh1.Range("H8:H" & DerLig)) Is Nothing Then
    ActiveSheet.Unprotect Password:=""
    Target.EntireRow.Copy Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Offset(1)
    
    Cancel = True
    Application.EnableEvents = False
    Application.EnableEvents = False
    Target.Value = Trim(Target.Value) & IIf(Right(Trim(Target.Value), 1) = "-", " ", " - ")
    If Target.Value = " - " Then Target.Value = ""
    Application.EnableEvents = True
    CreateObject("wscript.shell").SendKeys "{F2}"    'évite la désactivation du pavé numérique
    Exit Sub
  
End If
End Sub

@Phil69970

 

[Usine à gaz]

en core merci Phil69970 pour ce nouveau code.
Mais ça ne fonctionne pas car l'objectif est :
1 d'exécuter le code de Patrick qui ajoute le " - " et ouvre la cellule pour l'ajout d'un texte au texte existant
2 j'ajoute le texte et je valide,
3 la ligne est copiée en Feuil2,
Ouais c'est certainement coton et hors de mes connaissances en VBA,
lionel

 

[Phil69970]

Lionel

Encore un essai !!!

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim DerLig As String

Set Sh1 = Sheets("Feuil1")
Set Sh2 = Sheets("Feuil2")

DerLig = Sh1.Range("H" & Rows.Count).End(xlUp).Row

If Not Intersect(Target, Sh1.Range("H8:H" & DerLig)) Is Nothing Then
    ActiveSheet.Unprotect Password:=""
    
    Cancel = True
    Application.EnableEvents = False
    Application.EnableEvents = False
    Target.Value = Trim(Target.Value) & IIf(Right(Trim(Target.Value), 1) = "-", " ", " - ")
    If Target.Value = " - " Then Target.Value = ""
    Application.EnableEvents = True
    CreateObject("wscript.shell").SendKeys "{F2}"    'évite la désactivation du pavé numérique
   
    Target.EntireRow.Copy Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Offset(1)
    Exit Sub
 
End If
End Sub

@Phil69970

 

[Usine à gaz]

Re-
Je te remercie pour tes efforts.
Je suis vraiment désolé, mais ça ne fonctionne pas
En fait, il faut que le code de Patrick s'éxécute tel qu'il est et qu'à la validation "entrée" du texte
ajouté dans la cellule, la ligne soit copiée en Feuil2
lionel,