Creation automatique de ligne

bonjour tout le monde.

j'ai un petit problème sur ce code :

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

Application.ScreenUpdating = False

If Not Application.Intersect(Target, Range("A8:A65536")) Is Nothing Then

ActiveCell.EntireRow.Insert

Range("A7:w7").Copy ActiveCell

ActiveCell.RowHeight = 11.25

Cancel = True

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowInsertingRows:=True

End If

End Sub

ce code me permet d'ajouter des lignes dans un fichier verrouillé en double cliquant dans une colonne. sauf que ca ne marche qu'une fois. Au deuxième double clique ca m'envoie en déboguage en surlignant cette partie de code :

Range("A7:w7").Copy ActiveCell

à l aide

Bonsoir

Comme ceci ....

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Application.ScreenUpdating = False
  If Not Application.Intersect(Target, Range("A8:A65536")) Is Nothing Then
    Cancel = False
     ActiveSheet.Unprotect
      ActiveCell.EntireRow.Insert
      Range("A7:w7").Copy ActiveCell
      ActiveCell.RowHeight = 11.25
     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
      , AllowInsertingRows:=True
    Cancel = True
  End If
 Application.ScreenUpdating = True
End Sub

Formidable !!!!!

Merci beaucoup

Rechercher des sujets similaires à "creation automatique ligne"