• 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.

Tabblad met naam

Status
Niet open voor verdere reacties.
D

don42

Gebruiker
Lid geworden
25 apr 2014
Berichten
764
Beste helpers,

ik heb een tabblad invoer
daar wil ik via een userform de namen van de deelnemers in kolom A zetten
dat lukt nog (door eerdere hulp)
maar had graag dat gelijk tabblad Origineel gekopieerd werd (telkens als eerste geplaatst na tabblad invoer)
En dat dit tabblad de Naam krijgt van de zojuist ingevoerde naam
bij mij springt het hele zaakje dan over naar de net gekopieerde sheet en stopt het feestje
wie heeft de oplossing?
*eventuele namen in de bijlage zijn fictieve namen

Bekijk bijlage start poule.xlsm.

Ps
er zit nog verschil in de code als cel a2 nog leeg is ( geen invoer)

Don
 
Laatst bewerkt:
Met dit stukje als basis zou je verder moeten kunnen maken wat je er mee wil:
Code: 
Sub KopieerBlad()
    nwNaam = Range("A2")
    If nwNaam <> "" Then
        If Not Evaluate("ISREF('" & nwNaam & "'!A1)") Then
            Sheets("invoer").Copy after:=Sheets("invoer")
            ActiveSheet.Name = nwNaam
        Else
            MsgBox "Blad " & nwNaam & " bestaat al", vbCritical
        End If
    Else
        MsgBox "Een naam is verplicht", vbCritical
    End If
End Sub
 
Laatst bewerkt:
Ik ben er mee aan de slag gegaan,
En dit zou ongetwijfeld dicht bij de oplossing liggen maar heb het nog niet
 
Ik zie net pas dat het blad Origineel moet worden gekopiëerd.
Dan pas je dat toch aan in die code?
 
Nee nee

Nee het lukt niet

krijg het voor elkaar om de ingevoerde namen in kolom A keurig onder elkaar te krijgen

met jou code krijg ik het ook voor elkaar om een nieuw tabblad aan te maken met de net ingevoerde naam
maar krijg het niet gecombineerd
ga er morgen mee verder
ben bang dat ik anders de pc in hoek gooi
 
Ik denk dat je dan wat meer uitleg moet geven over wat precies de bedoeling is.
Een nieuw blad maken met de ingevoerde naam gaat dus goed met mijn voorbeeldje.
En dan?
 
Wat uiteindelijk de bedoeling is dat er in tabblad invoer in de kolom A
vanaf a2 t/m ?
de namen komen te staan van de deelnemers
tegelijkertijd een kopie van tabblad origineel wat de naam krijgt van de juist ingevulde deelnemer

Dit heb ik
mogelijk van jou of hsv
Code: 
Private Sub CommandButton1_Click()
On Error GoTo don
    If Range("b2").Value = ("") Then 'Tot hier is enkel om geen foutmelding te krijgen als de rij nog leeg is...
        Range("b2").Select
        If TextBox1.Value = "" Then
            MsgBox "Je moet de naam van een deelnemer invullen!." & vbNewLine & "En dan 2x op Enter voor de volgende" & vbNewLine & "Of op stop om het invoeren te beëindigen", vbExclamation, "Oeps foutje   Café de Breer©"
            Me.TextBox1.SetFocus
            Exit Sub
        End If
        
        Range("b1").Select
        TextBox1.Value = UEWLW(TextBox1.Value)
        Range("b2").Value = TextBox1.Text
        ActiveCell.End(xlDown).Offset(1, 0).Select
        TextBox1.Text = ""
        Me.TextBox1.SetFocus
        Exit Sub
    End If
    
    Range("b1").Select
    ActiveCell.End(xlDown).Select
    laatste = ActiveCell.Row
    TextBox1.Value = UEWLW(TextBox1.Value)
    Cells(laatste + 1, 2).Value = TextBox1.Text
    If TextBox1.Value = "" Then
        Cells(laatste + 1, 2).Select
        MsgBox "Je moet de naam van de deelnemer invullen!.", vbExclamation, "Oeps foutje   Café de Breer©"
        Me.TextBox1.SetFocus
        Exit Sub
    End If
    
    TextBox1.Text = ""
    Me.TextBox1.SetFocus
    ActiveCell.End(xlDown).Offset(1, 0).Select
don:
End Sub

Function UEWLW(Regel As String) As String
    Dim i As Integer
    
    For i = Len(Trim(Regel)) To 1 Step -1
        If Mid(Regel, i, 1) = " " Then Exit For
    Next i
    
    i = i + 1
    Mid(Regel, 1, 1) = UCase(Mid(Regel, 1, 1))
    Mid(Regel, i, 1) = UCase(Mid(Regel, i, 1))
    UEWLW = Regel
End Function

en zet de namen keurig onder elkaar
 
Laatst bewerkt:
Welk nut heeft het om allemaal losse tabjes aan te maken? En waarom moet de knop steeds meegaan naar een nieuwe tab?
 
Laatst bewerkt:
#8
nee deze knop hoeft niet perse mee
sheet wordt een blad met enige code die wel volledig gekopieerd moet worden
 
Er is ook geen knop voor nodig.
Vul hier gewoon in het blad invoer in Kolom A vanaf Regel 2 de gewenste namen in:
Bekijk bijlage start poule-1.xlsm

Je zal ook zien dat er niks veranderd is aan de code die ik in #2 plaatste.
Die is echt als basis gebruikt.

NB.
Het te kopiëren blad heet Orgineel en je zal Origineel bedoelen.
Alle overbodige zaken aan code, knoppen, modules en het userform heb ik verwijderd.

De enige code die er nog in zit kan je vinden achter het blad invoer en ziet er zo uit:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        nwNaam = Target.Value
        If nwNaam <> "" Then
            nwNaam = Application.Proper(nwNaam)
            If Not Evaluate("ISREF('" & nwNaam & "'!A1)") Then
                Sheets("Orgineel").Copy after:=Sheets("invoer")
                ActiveSheet.Name = nwNaam
                Target.Value = nwNaam
            End If
        End If
    End If
    Sheets("invoer").Activate
End Sub
 
Laatst bewerkt:
Als onderstaande code mee moet dan zou ik nog eens goed kijken naar de foutafhandeling in #2

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Application.Intersect(Range("A2"), Target) Is Nothing Then
  ActiveSheet.Name = ActiveSheet.Range("A1")
Else
End If
End Sub
 
#10
Super
bedankt dit is echt top
 
Laatst bewerkt:
Je opmerking over wat er mis gaat begrijp ik niet.
Wellicht dat je bij verwijderen bedoelt?
Maak er dan dit van:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   [COLOR="#FF0000"] If Target.Count = 1 Then[/COLOR]
        If Target.Column = 1 And Target.Row > 1 Then
            nwNaam = Target.Value
            If nwNaam <> "" Then
                nwNaam = Application.Proper(nwNaam)
                If Not Evaluate("ISREF('" & nwNaam & "'!A1)") Then
                    Sheets("Orgineel").Copy after:=Sheets("invoer")
                    ActiveSheet.Name = nwNaam
                    Target.Value = nwNaam
                End If
            End If
        End If
        Sheets("invoer").Activate
    [COLOR="#FF0000"]End If[/COLOR]
End Sub
 
edmoor zei:
Je opmerking over wat er mis gaat begrijp ik niet.
Wellicht dat je bij verwijderen bedoelt?
Maak er dan dit van:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   [COLOR="#FF0000"] If Target.Count = 1 Then[/COLOR]
        If Target.Column = 1 And Target.Row > 1 Then
            nwNaam = Target.Value
            If nwNaam <> "" Then
                nwNaam = Application.Proper(nwNaam)
                If Not Evaluate("ISREF('" & nwNaam & "'!A1)") Then
                    Sheets("Orgineel").Copy after:=Sheets("invoer")
                    ActiveSheet.Name = nwNaam
                    Target.Value = nwNaam
                End If
            End If
        End If
        Sheets("invoer").Activate
    [COLOR="#FF0000"]End If[/COLOR]
End Sub
Klik om te vergroten...

Helemaal top
dank je wel
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan