• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

werkblad beveiligen waarop gegevens komen te staan die door macro worden gegenereerd

Status
Niet open voor verdere reacties.

rvdw1968

Gebruiker
Lid geworden
20 jul 2018
Berichten
39
Beste allemaal,

ik heb een excel-sheet gemaakt waarbij gegevens van blad 1, door een macro worden gekopieerd naar blad 2.
(ik verwijs naar mijn eerdere vraag die te vinden is onder "Onderwerp: Gegevens blad1 permanent bewaren op blad 2") alwaar de door edmoor gemaakte macro weergegeven staat.

Door deze macro worden de gegevens van blad 1, permanent weergegeven op blad 2. Ook indien de gegevens op blad 1 verwijderd worden, blijven ze op blad 2 bewaard.

Ik wil de op blad 2 weergegeven gegevens graag beschermen tegen (foutief) wissen door onbevoegden. De werkwijze van "blad beveiligen" werkt niet want de macro schrijft geen gegevens weg op geblokkeerde cellen.
Wel wil ik graag de mogelijkheid blijven behouden om, d.m.v. een wachtwoord, de gegevens door bevoegde personen wél te laten verwijderen.

Weet iemand een manier hiervoor?

Alvast mijn dank voor de hulp
 
Beveilig de tweede sheet met een wachtwoord en zorg dat de macro de beveiliging er tijdens het verwerken van de gegevens even afhaalt.

Code:
Sub kopieerblad1naarblad2()
    Dim rtu As Long
    Dim XXX As Range
    Dim shOLZ As Worksheet
    Dim shOLB As Worksheet
   
    Set shOLZ = Sheets("blad1")
    Set shOLB = Sheets("blad2")
    
    With shOLB
        [COLOR="#FF0000"][/COLOR][COLOR="#FF0000"].Unprotect "Wachtwoord"[/COLOR]
        rtu = 4
        While .Cells(rtu, 1) <> ""
            rtu = rtu + 1
        Wend
    End With

    For i = 9 To 36
        If shOLZ.Cells(i, 1) <> "" Then
            Set XXX = shOLB.Columns("E").Find(shOLZ.Cells(i, "K").Value, LookIn:=xlValues)
            If XXX Is Nothing Then
                shOLB.Cells(rtu, "A") = shOLZ.Cells(i, "A").Value
                shOLB.Cells(rtu, "B") = shOLZ.Cells(i, "C").Value
                shOLB.Cells(rtu, "C") = shOLZ.Cells(i, "E").Value
                shOLB.Cells(rtu, "D") = shOLZ.Cells(i, "G").Value
                shOLB.Cells(rtu, "E") = shOLZ.Cells(i, "K").Value
                shOLB.Cells(rtu, "F") = shOLZ.Cells(i, "AM").Value
                shOLB.Cells(rtu, "G") = shOLZ.Cells(i, "AN").Value
                shOLB.Cells(rtu, "I") = shOLZ.Cells(i, "AO").Value
                rtu = rtu + 1
            End If
        End If
    Next i
    [COLOR="#FF0000"]shOLB.Protect "Wachtwoord"[/COLOR]
End Sub

En als je voortaan verwijst naar een eerdere vraag, plaats dan op zijn minst even een link naar deze vraag. :thumb:
 
Laatst bewerkt:
Beste SjonR,

hartelijk dank voor deze oplossing!!!
(en de les in forum-etiquette :) )
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan