Hoe maak ik een macro die sheet gericht kan unprotecten

[Tijger81]

Hallo,

Ik heb een code die voor mij cellen van de ene sheet naar het andere kan kopieren. In de sheet "Invoer" Range (D15) wordt bepaald naar welke sheet de celinhoud gekopieerd moet worden. cel D15 is namelijk een dropdownmenu waar blad 1, blad 2, blad 3. blad 4 staat. Daaruit kunnen mensen kiezen.
Alleen nu unprotect ik alle sheets, omdat het mij niet lukt om gericht te unprotecten. Dus dat de macro ervoor zorgt dat alleen de sheet geunprotect wordt waarnaar toe gekopieerd gaat worden.
Dus stel dat iemand Blad 3 kiest dat alleen blad 3 geunprotect en later geprotect wordt.

Sub Toevoegen()
'check of velden ingevuld zijn
 Tel = 0
 For i = 4 To 12
 If IsEmpty(Sheets("invoer").Cells(15, i)) Then
 MsgBox "Je hebt niet al de gegevens ingevuld": i = 12
 Else
 Tel = Tel + 1
 End If
 Next i
 If Tel = 9 Then
 'beveiliging eraf doen
 Sheets("blad 1").Unprotect Password:="x1"
 Sheets("blad 2").Unprotect Password:="x2"
 Sheets("blad 3").Unprotect Password:="x3"
 Sheets("blad 4").Unprotect Password:="x4"
 'Tekst van invoer naar bestand kopieren
 With Sheets(Sheets("Invoer").Range("D15").Value)
  .Rows(15).Insert Shift:=Down
 Worksheets("invoer").Range("C15:O15").Copy
 With .Range("A16:M16")
 .PasteSpecial xlPasteValues
 .Borders.LineStyle = xlContinuous
 .Interior.Pattern = xlNone
 End With
 Worksheets("invoer").Range("D15:L15").ClearContents
 End With
 End If
 'Activeren van de beveiliging en het onzichtbaar maken van het tabblad bestand
 Sheets("blad 1").Protect Password:="x1"
 Sheets("blad 2").Protect Password:="x2"
 Sheets("blad 3").Protect Password:="x3"
 Sheets("blad 4").Protect Password:="x4"
 If Tel = 9 Then MsgBox "De gegevens zijn toegvoegd"
 End Sub

 

[JeanPaul28]

Vervang deze eens voor alle sheets
Sheets([D15].Value).Protect Password:="x" & Right([D15].Value, 1)

 

[Warme bakkertje]

Sub Toevoegen()
    'check of velden ingevuld zijn
    If WorksheetFunction.CountA(Sheets("invoer").Range("D15:L15")) <> 9 Then MsgBox "Je hebt niet al de gegevens ingevuld": Exit Sub
    With Sheets(Sheets("Invoer").Range("D15").Value)
        'beveiliging eraf doen
        .Unprotect Password:="x" & Right(Sheets("Invoer").Range("D15").Value, 1)
        .Rows(15).Insert Shift:=Down
        'Tekst van invoer naar bestand kopieren
        Sheets("invoer").Range("C15:O15").Copy
        With .Range("A16:M16")
            .PasteSpecial xlPasteValues
            .Borders.LineStyle = xlContinuous
            .Interior.Pattern = xlNone
        End With
        'Activeren van de beveiliging en het onzichtbaar maken van het tabblad bestand
        .Protect Password:="x" & Right(Sheets("Invoer").Range("D15").Value, 1)
    End With
    Sheets("invoer").Range("D15:L15").ClearContents
    MsgBox "De gegevens zijn toegvoegd"
End Sub

 

[Tijger81]

Dank voor de reacties.
Ik heb zitten te denken en wil overal hetzelfde wachtwoord: denied. Maar hoe krijg ik het dan werkend? Ik heb het onderstaande geprobeerde maar werkt nog niet.

Sub Toevoegen()
    'check of velden ingevuld zijn
    If WorksheetFunction.CountA(Sheets("invoer").Range("D15:L15")) <> 9 Then MsgBox "Je hebt niet al de gegevens ingevuld": Exit Sub
    With Sheets(Sheets("Invoer").Range("D15").Value)
        'beveiliging eraf doen
        .Unprotect Password:="denied" & Right(Sheets("Invoer").Range("D15").Value)
        .Rows(15).Insert Shift:=Down
        'Tekst van invoer naar bestand kopieren
        Sheets("invoer").Range("C15:O15").Copy
        With .Range("A16:M16")
            .PasteSpecial xlPasteValues
            .Borders.LineStyle = xlContinuous
            .Interior.Pattern = xlNone
        End With
        'Activeren van de beveiliging en het onzichtbaar maken van het tabblad bestand
        .Protect Password:="denied" & Right(Sheets("Invoer").Range("D15").Value)
    End With
    Sheets("invoer").Range("D15:L15").ClearContents
    MsgBox "De gegevens zijn toegevoegd"
End Sub
[\code]

 

[JeanPaul28]

test deze eens

Sub Toevoegen()
'check of velden ingevuld zijn
If WorksheetFunction.CountA(Sheets("invoer").Range("D15:L15")) <> 9 Then MsgBox "Je hebt niet al de gegevens ingevuld": Exit Sub
With Sheets(Sheets("Invoer").Range("D15").Value)
'beveiliging eraf doen
.Unprotect Password:="denied" & Right(Sheets("Invoer").[D15].Value, 1)
'.Unprotect Password:="denied" & Right(Sheets("Invoer").Range("D15").Value)
.Rows(15).Insert Shift:=Down
'Tekst van invoer naar bestand kopieren
Sheets("invoer").Range("C15:O15").Copy
With .Range("A16:M16")
.PasteSpecial xlPasteValues
.Borders.LineStyle = xlContinuous
.Interior.Pattern = xlNone
End With
'Activeren van de beveiliging en het onzichtbaar maken van het tabblad bestand
.Protect Password:="denied" & Right(Sheets("Invoer").[D15].Value, 1)
'.Sheets([D15].Value).Protect Password:="denied" & Right([D15].Value, 1)
'.Protect Password:="denied" & Right(Sheets("Invoer").Range("D15").Value)
End With
Sheets("invoer").Range("D15:L15").ClearContents
MsgBox "De gegevens zijn toegevoegd"
End Sub

 

[Tijger81]

Nop. krijg deze regel in het geel:

.Unprotect Password:="denied" & Right(Sheets("Invoer").[D15].Value, 1)

Hij zegt dat het wachtwoord verkeerd is, maar het gewoon het goede.

Waarom moet eigenlijk Value 1 erachter

 

[Warme bakkertje]

Je moet bij alle werkbladen wel eerst de oude paswoorden verwijderen alvorens de macro te draaien.
Met de 1 wordt aangeduid dat er slechts 1 teken rechts v/d string gebruikt mag worden. Kijk hiervoor maar eens in de VBA-Helpfiles voor meer uitleg.

 

[Tijger81]

Dank je Rudi, dat was het probleem. Nu wordt de celinhoud toegvoegd aan de juiste sheet.
Dat werkt nu.
Alleen ik kan niet handmatig de blad beveiliging opheffen. Dan wordt er gezegd dat ik het verkeerde wachtwoord heb getypt. Caps locks uit en paar keer geprobeerd.

 

[Warme bakkertje]

Volgens de code wordt dit voor Blad 1 - denied1, voor Blad 2 - denied2, enz...

 

[Tijger81]

Oke, kan het niet gewoon voor alle bladen denied zijn?

 

[Warme bakkertje]

Laat dan bij Unprotect en Protect dit deel weg

 & Right(Sheets("Invoer").[D15].Value, 1)

 

[Tijger81]

Dank je.
Dat had ik ook al eerder geprobeerd alleen toen stonden de sheets nog geblokkeerd met een ander wachtwoord en toen werkte het niet.
Logisch eigenlijk.

Bedankt!