Naar eerstvolgende lege kolom

[wieter]

Met een druk op de knop moeten de gegevens opgeslagen worden in de eerstvolgende lege kolom,
op het juiste tabblad.
De rode regel in de code doet echter niet wat ik voor ogen had.

Private Sub CommandButton1_Click()
Dim Naam As String
Dim Laatstekolom As Variant
If Range("E4") = "" Then If MsgBox("Vul eerst je naam in a.u.b.") Then Exit Sub
    On Error Resume Next
        Naam = Worksheets("Blad1").Range("E4").Value
        If Worksheets(Naam) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = Naam
                .Range("A1:B34").Value = Worksheets("Blad1").Range("B2:C35").Value
            End With
        End If
        Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
        
      [COLOR="#FF0000"]  'Worksheets(Naam).Range(Laatstekolom & "1" & ":" & Laatstekolom + 1 & "35").Value = Worksheets("Blad1").Range("B2:C35").Value[/COLOR]
               
    Worksheets("Blad1").Activate
ActiveSheet.Unprotect
Range("B5:B35,B2,B3,E4").ClearContents
Range("B5:B35").Locked = False
ActiveSheet.Protect
End Sub

Wil iemand helpen met de juiste syntax?

Bekijk bijlage spelling3.xlsm

 

[Cobbe]

Tja, moeten wij nu gissen wat jij voor ogen hebt?

 

[wieter]

Bedoeling van bestand: Individueel onderwijs.
De kolom met de woorden is verborgen
Begeleider dicteert een woord en de leerling tikt dit woord in.
Als hij klaar is -- knop [Klaar].
Het resultaat wordt weg geschreven naar het juiste tabblad.
Als diezelfde leerling weer een woordpakket invult, moet het resultaat weer weg geschreven worden naar ZIJN tabblad
en achter de kolommen die er al staan.
Hopelijk is het nu duidelijker.

 

[Cobbe]

Anders moest je eens testen met deze aangepaste code:

Private Sub CommandButton1_Click()
Dim Naam As String
Dim Laatstekolom As Variant
If Range("E4") = "" Then If MsgBox("Vul eerst je naam in a.u.b.") Then Exit Sub
    On Error Resume Next
        Naam = Worksheets("Blad1").Range("E4").Value
        If Worksheets(Naam) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = Naam
                .Range("A1:B34").Value = Worksheets("Blad1").Range("B2:C35").Value
            End With
        End If
        Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
    With Sheets("Blad1")
            .Range("B2:C35").Copy Worksheets(Naam).Cells(1, Laatstekolom)
            .Activate
            .Unprotect
            .Range("B5:B35,B2,B3,E4").ClearContents
            .Range("B5:B35").Locked = False
            .Protect
     End With
End Sub

 

[wieter]

Bedankt Cobbe,
De code werkt perfect.
Enkel één storing: Als het tabblad nog niet bestaat, wordt dit tabblad aangemaakt en worden de resultaten 2x gecopieërd.
Eénmaal door dit:

If Worksheets(Naam) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = Naam
                .Range("A1:B34").Value = Worksheets("Blad1").Range("B2:C35").Value
            End With
        End If

En daarna nogmaals door dit:

Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
    With Sheets("Blad1")
            .Range("B2:C35").Copy Worksheets(Naam).Cells(1, Laatstekolom)
            .Activate
            .Unprotect
            .Range("B5:B35,B2,B3,E4").ClearContents
            .Range("B5:B35").Locked = False
            .Protect
     End With

Als het tabblad al bestaat loopt de code perfect.

 

[Cobbe]

DAn haal je toch die eerste copy/paste er uit:

Private Sub CommandButton1_Click()
Dim Naam As String
Dim Laatstekolom As Variant
If Range("E4") = "" Then If MsgBox("Vul eerst je naam in a.u.b.") Then Exit Sub
    On Error Resume Next
        Naam = Worksheets("Blad1").Range("E4").Value
        If Worksheets(Naam) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            Worksheets(Worksheets.Count).Name = Naam
        End If
        Laatstekolom = Worksheets(Naam).UsedRange.Columns.Count + 1
    With Sheets("Blad1")
            .Range("B2:C35").Copy Worksheets(Naam).Cells(1, Laatstekolom)
            .Activate
            .Unprotect
            .Range("B5:B35,B2,B3,E4").ClearContents
            .Range("B5:B35").Locked = False
            .Protect
     End With
End Sub

 

[wieter]

Weer heb je me verder geholpen Cobbe.
Bedankt voor jou vrijwillige inzet
Groeten