bloquer une cellule en fonction de la valeur d'une autre

[Neofalken]

Bonjour le forum,

j'aurais à nouveau besoin de votre aide :
J'aimerais bloquer une cellule (interdire la sélection) en fonction de la valeur d'une autre (je ne peux pas utiliser les validations de données car j'en ai déjà dans les cellules en question).
J'ai ce code qui fonctionne pour une cellule:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("G2"), Target) Is Nothing Then
Select Case Range("G2").Value
Case Is > 0
ActiveSheet.Unprotect
Cells.Locked = False
Range("B2").Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Case Else
ActiveSheet.Unprotect
Cells.Locked = True
End Select
End If
End Sub

Mais j'aimerais que cela se répète sur toutes les cellules de la colonne B en fonction des saisies des cellules de la colonne G.
Je crois qu'il faut utiliser la fonction boucle, mais je sèche un peu...

Pourriez-vous m'aider svp ?

Merci d'avance

 

[Jacky67]

Bonjour le forum,

j'aurais à nouveau besoin de votre aide :
J'aimerais bloquer une cellule (interdire la sélection) en fonction de la valeur d'une autre (je ne peux pas utiliser les validations de données car j'en ai déjà dans les cellules en question).
J'ai ce code qui fonctionne pour une cellule:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("G2"), Target) Is Nothing Then
Select Case Range("G2").Value
Case Is > 0
ActiveSheet.Unprotect
Cells.Locked = False
Range("B2").Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Case Else
ActiveSheet.Unprotect
Cells.Locked = True
End Select
End If
End Sub

Mais j'aimerais que cela se répète sur toutes les cellules de la colonne B en fonction des saisies des cellules de la colonne G.
Je crois qu'il faut utiliser la fonction boucle, mais je sèche un peu...

Pourriez-vous m'aider svp ?

Merci d'avance

Bonjour,
Ceci peut-être

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
Dim Derlg&, C As Range
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Derlg = Cells(Rows.Count, "G").End(xlUp).Row
ActiveSheet.Unprotect
Cells.Locked = False
For Each C In Range("g1:g" & Derlg)
  If IsNumeric(C) And C.Value > 0 Then
    C.Offset(, -5).Locked = True
  End If
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

 

[Neofalken]

Génial !!!

Merci bcp Jacky67 !!!