Macro ajout de ligne - debogage 1 x sur 2

Bonjour à tous,

Je viens vers vous cette fois-ci car j'ai une macro ajout de ligne reliée à un bouton qui semble marcher aléatoirement.

En effet je n'ai pas réussi à identifier pourquoi parfois elle fonctionne et pourquoi d'autres fois elle ne fonctionne pas!

J'ai juste remarqué que le premier ajout de ligne pose toujours problème.

Quand je rentre dans le debogage, j'arrive sur la ligne suivante :

If Target.Value = "Clé" ....

Je vous joins mon fichier (mdp : "victor" // le bouton ajout de ligne est dans l'onglet devis).

Voici le code de ma macro ajout de ligne :

Sub AjoutLigne()
'
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="victor"
'
Dim Ligne As Long
'
Ligne = [LigneTotalDevis].Row - 1
'
With Rows(Ligne)
   .Copy
'  .Selection.EntireRow.Insert
   .Insert Shift:=xlDown
   .Hidden = False
End With
'
Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="victor"
'
End Sub

Et voici le code ou le debugage me conduit :

Private Sub Worksheet_Change(ByVal Target As Range)
'
'On facilite la saisie de l'utilisateur en préremplissant certaines cellules
'
'Permet de supprimer une plage de cellule sans que ça bug
If Selection.Count > 1 Then Exit Sub
'
Application.EnableEvents = False
'
'Extensions
If Not Intersect(Target, Range("E16")) Is Nothing Then
    [E17] = IIf(Target = "Oui", "Oui", "NA")
    [E18] = IIf(Target = "Oui", "Non", "NA")
End If
'
'Types d'article
If Not Intersect(Target, Range("C22:C50")) Is Nothing Then
'Clés
    If Target.Value = "Clé" Then Target.Offset(0, 2).Resize(1, 4).Value = "NA"
'Cylindres
    If Target.Value = "Cylindre" Then Target.Offset(0, 4) = "Standard (Laiton nickelé satiné)"
End If
'
'Articles
If Not Intersect(Target, Range("D22:D50")) Is Nothing Then
    If Target.Value = "Double entrée" Then Target.Offset(0, 1).Resize(1, 2).Value = 31.5
    If Target.Value = "Bouton" Then Target.Offset(0, 4) = "Standard (forme H)"
    If Target.Value = "Demi-cylindre" Then
        Target.Offset(0, 1) = 10
        Target.Offset(0, 2) = 31.5
        Target.Offset(0, 4) = "NA"
    End If
End If
'
Application.EnableEvents = True
'
'
End Sub

Merci d'avance pour vos retours!

Vip4rk

Bonsoir,

Est-ce que tu peux essayer de remplacer :

'Permet de supprimer une plage de cellule sans que ça bug
If Selection.Count > 1 Then Exit Sub

par

'Permet de supprimer une plage de cellule sans que ça bug
If Target.Count > 1 Then Exit Sub

Alors là je suis scotché @oxydum mais ça semble effectivement marcher!!

Bravo à toi^^

Et surtout merci!!

Vip4rk