Copiëren naar juiste tabblad

[wieter]

Met bijgevoegd bestand oefenen kinderen hun spelling.
Na het invullen van hun naam en de gedicteerde woorden, drukt men op klaar, en de prestatie van het kind wordt in hun tabblad opgeslagen.
Tot zover alles OK.

Probleem: Als een kind een tweede woordpakket wil oefenen, loopt het opslaan in zijn tabblad fout.
Kan iemand de code achter de knop "Klaar" aanpassen, zodat ook volgende oefenreeksen opgeslagen worden?

Bekijk bijlage Spelling.xlsm

 

[ExcelAmateur]

Ik denk dat ben vergeten om eerst de beveiliging van het blad te halen.
Onderaan staat wel dat de beveiliging er op moet.

@
Maar dan gaat het nog niet goed.

 

[MarcelBeug]

Misschien dat en passant ook "jou naam" in D4 nog kan worden gecorrigeerd naar "jouw naam"...

 

[ExcelAmateur]

Ik heb de eerste regel waar het fout gaat even uitgeschakeld.
De 2e regel heb ik even opgenomen en kwam dit uit en dat werkte.

'Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial xlPasteFormats
            Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 

[wieter]

Bedankt Excelamateur, jouw aanpassing heeft voor de oplossing gezorgd.
@MarcelBeul, straf hé, een fout in een spellingsoefening.

Bedankt voor de oplossing

 

[MarcelBeug]

MarcelBeul

 

[wieter]

Ik heb te vroeg gejuicht. Het copiëren loopt toch nog mis.
Bij drukken op de knop "Klaar" verschijnt een foutmelding. Als ik nu die foutmelding negeer, en opnieuw op de knop "Klaar" druk,
werkt het wel. Raaaaaar!
Wie kan het oplossen?

Private Sub CommandButton1_Click()
Dim Naam As String
Dim Laatstekolom As Long
If Range("E4") = "" Then If MsgBox("Vul eerst je naam in a.u.b.") Then Exit Sub
        Naam = Worksheets("Blad1").Range("E4").Value
        If IsError(Evaluate("'" & Naam & "'!E4")) Then
        Sheets.Add(, Sheets(Sheets.Count)).Name = Naam
        With Sheets(Sheets.Count)
                .Range("A1") = Naam
        End With
        End If
        Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
        With Worksheets("Blad1")
            .Range("B2:C39").Copy
            Sheets(Naam).Unprotect
            Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial xlPasteFormats
            Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial Paste:=xlPasteValues
            Sheets(Naam).Protect
             Application.CutCopyMode = False
            .Activate
            .Unprotect
            .Range("B5:B35,B2,B3,E4").ClearContents
            .Range("B5:B35").Locked = False
            .Protect
        End With
End Sub

Bekijk bijlage Spelling.xlsm

 

[VenA]

Het lijkt erop dat de unprotect in de weg zit.
Probeer het zo eens.

Dim Laatstekolom As Long
If Range("E4") = "" Then If MsgBox("Vul eerst je naam in a.u.b.") Then Exit Sub
        Naam = Worksheets("Blad1").Range("E4").Value
        If IsError(Evaluate("'" & Naam & "'!E4")) Then
        Sheets.Add(, Sheets(Sheets.Count)).Name = Naam
        With Sheets(Sheets.Count)
                .Range("A1") = Naam
        End With
        End If
        Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
        Sheets(Naam).Unprotect
        With Worksheets("Blad1")
            .Range("B2:C39").Copy
            Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial xlPasteFormats
            Sheets(Naam).Cells(1, Laatstekolom).PasteSpecial Paste:=xlPasteValues
            Sheets(Naam).Protect
             Application.CutCopyMode = False
            .Activate
            .Unprotect
            .Range("B5:B35,B2,B3,E4").ClearContents
            .Range("B5:B35").Locked = False
            .Protect
        End With
End Sub

 

[wieter]

Bingo!! VenA, dat was het.
De plaats van die Unprotect was de oorzaak.
Knap van je, om dat te vinden!!!