Cellen beveiligen tegen deleten

[jdel]

Okee, bij die code voor het beveiligen van de cellen tegen het deleten in tabblad ontwikkelnummers overschrijft hij de kolom B als er een waarde instaat.

Maar hij kopieert dat dan naar ook naar kolom B in andere tabbladen :S

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each cl In Sheets("Ontwikkelnummers").Range("B9:B303")
Mycheck = cl.Value Like "??*******"
If Mycheck = True Then Cells(cl.Row, cl.Column) = cl.Value
Next
End Sub

 

[Cobbe]

Dan zou deze toch moeten werken:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  With Sheets("Ontwikkelnummers")
    For Each cl In .Range("B9:B303")
       Mycheck = cl.Value Like "??*******"
          If Mycheck = True Then .Cells(cl.Row, cl.Column) = cl.Value
    Next
  End with
End Sub

 

[jdel]

Ok perfect!
Werkt zoals het hoort.


Een ander vraagje, wat voor jouw waarschijnlijk zo gedaan is.
Is er ook zo'n stukje code waarmee hij in die sheet van bijv. alle cellen in kolom K van 9 t/m 303 automatisch de waarde kopieert naar kolom L van 9 t/m 303 bij afsluiten?

 

[Cobbe]

Kleine moeite:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  For Each cl In Sheets("Ontwikkelnummers").Range("B9:B303")
    Mycheck = cl.Value Like "??*******"
        If Mycheck = True Then Cells(cl.Row, cl.Column) = cl.Value
    Next
    
    For Each cl In Sheets("Ontwikkelnummers").Range("K9:K" & Range("K303").End(xlUp).Row)
        cl.Offset(, 1) = cl
    Next
End Sub

 

[jdel]

De cellen worden nu netjes door de macro opnieuw 'geplakt', maar daardoor kan je de cel niet op blokkeren zetten.

Kan je in de code deze cellen ook eerst deblokkeren in kolom B, dan overschrijven, en dan weer opnieuw blokkeren?

 

[Cobbe]

Ik snap echt niet wat er moet gebeuren.

 

[jdel]

Bij cel eigenschappen - bescherming kan je een cel op blokkeren zetten.
En zodra de bladbeveiliging instaat kan je dan die cel niet bewerken.

Maar de code die de cel opnieuw schrijft die je me hebt opgegeven:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  For Each cl In Sheets("Ontwikkelnummers").Range("B9:B303")
    Mycheck = cl.Value Like "??*******"
        If Mycheck = True Then Cells(cl.Row, cl.Column) = cl.Value
    Next
    End Sub

Heeft dan geen schrijfrechten en geeft een foutmelding.

Nu heb ik de vraag of je via die code ook bij cellen eerst de blokkering uit kan zetten, dan laat overschrijven en dan weer de blokkeren aan kan zetten.

 

[Cobbe]

Haha, dat is het dus, de bladbeveiliging wordt er nu afgehaald en terug opgezet maar zonder wachtwoord:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Ontwikkelnummers").Unprotect
  For Each cl In Sheets("Ontwikkelnummers").Range("B9:B303")
    Mycheck = cl.Value Like "??*******"
        If Mycheck = True Then Cells(cl.Row, cl.Column) = cl.Value
    Next
    
    For Each cl In Sheets("Ontwikkelnummers").Range("K9:K" & Range("K303").End(xlUp).Row)
        cl.Offset(, 1) = cl
    Next
Sheets("Ontwikkelnummers").Protect
End Sub

 

[jdel]

Ah perfect!

Dat bedoelde ik idd haha