Empècher effacement

[Michel68000]

Bonjour,

dans ma feuille en A2:A60 j'ai une liste de noms et en B,C....M les coordonnées de ces gens.
En F si j'ai une date d'entrée ,je voudrais m'en servir pour fixer la ligne de A(x )à M(x).


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(Target.Row, 6) < Date And Target.Column <> 6 Then
La je voudrais que la cellule A(x)de la ligne concernée passe de protect=false à true
End If
End Sub

J'ai essayé pas mal de trucs mais rien y fait la propriété protection de la cellule ne passe jamais à protégé.Si elle passait en protégé l'utilisateur n'aurait pas la possibilité de l'effacer oude le modifier.
Si qq à une astuce ça m'éviterais de vérifier manuellement tous les onglets
Merci d'avance

 

[SergiO]

Re : Empècher effacement

Bonjour Michel

Un code à tester si j'ai bien compris...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A2:M60")) Is Nothing Then
ActiveSheet.Unprotect
If Cells(Target.Row, 6) < Date And Cells(Target.Row, 6) <> "" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Locked = True
Else
Range(Cells(Target.Row, 1), Cells(Target.Row, 13)).Locked = False
End If
End If
ActiveSheet.Protect
End Sub

@+