Bonjour à tous !
Après un bon travail de recherche et d'aide de toutes parts, je souhaiterais finaliser le code ci dessous.
Je cherche donc un code permettant de bloquer la sélectionner de plusieurs cellules (soit par souris, soit par clavier), et je ne sais pas si cela existe, un code pour vérouiller par un mot de passe la modification du code de la feuille ...???
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim plg As Range
Dim derlig
derligne = Range("A" & Application.Rows.Count).End(xlUp).Row
Cancel = True
If Not Application.Intersect(Target, Range("A2:BZ2")) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("A4:BZ" & derligne - 2)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("D" & derligne & ":E" & derligne)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("N" & derligne & ":BZ" & derligne)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
End Sub
Merci à tous pour votre précieuse aide !!
Après un bon travail de recherche et d'aide de toutes parts, je souhaiterais finaliser le code ci dessous.
Je cherche donc un code permettant de bloquer la sélectionner de plusieurs cellules (soit par souris, soit par clavier), et je ne sais pas si cela existe, un code pour vérouiller par un mot de passe la modification du code de la feuille ...???
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim plg As Range
Dim derlig
derligne = Range("A" & Application.Rows.Count).End(xlUp).Row
Cancel = True
If Not Application.Intersect(Target, Range("A2:BZ2")) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("A4:BZ" & derligne - 2)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("D" & derligne & ":E" & derligne)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
If Not Application.Intersect(Target, Range("N" & derligne & ":BZ" & derligne)) Is Nothing And Target.Count = 1 Then
If Target.Value <> "" Then
Range("A" & derligne + 1).Select
End If
End If
End Sub
Merci à tous pour votre précieuse aide !!