Nieuw tabblad aanmaken met knop

[Jasper]

Goedemorgen forum,

 

Ik ben druk bezig met een bestand en was gaan kijken naar de mogelijkheden om automatisch en nieuw tabblad te generen aan de hand van ingevoerde waardes.

 

Ik heb het volgende gevonden:

 

Daar gebruiken ze deze code:

Sub add_new_sheet()

Dim sheet_name_to_create As String
Dim sh As Worksheet, nsh As Worksheet ' nsh = sheet_name_to_create
Dim nrng As Range
Dim cont As Worksheet
Dim oRng As Range

sheet_name_to_create = ActiveCell.Value
 Set oRng = ActiveCell
Set sh = Sheets("blad1")

For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then

MsgBox "this sheet already exists"
Exit Sub
End If

Next

Sheets("markbreakdown").Visible = True
Sheets("markbreakdown").Copy after:=Sheets(Sheets.Count)

ActiveWindow.ActiveSheet.Name = sheet_name_to_create
Sheets("markbreakdown").Visible = False

sh.Activate
sh.Hyperlinks.Add oRng, "", "'" & sheet_name_to_create & "'!A1", _
"Go to " & sheet_name_to_create, sheet_name_to_create

Set oRng = Nothing

End Sub

Nou heb ik die overgenomen en getest maar lukt het nog niet helemaal. Ik krijg de fout: Fout 9 tijdens uitvoering: het subscript valt buiten het bereik (als ik zelf het tabblad kees aanmaakt en wil toevoegen via de knop dan ziet hij wel dat die al bestaat)

 

tevens is dit ook maar en begin van wat ik eigenlijk zou willen.

 

Hier neemt ze dus en blad als voorbeeld en die kopieert ze deze inclusief de basis gegevens.

 

Naar mijn idee zou het werken dat ik en naam invul. de naam zal dan gebruikt worden als de naam van het nieuwe tabblad.

tevens kopieert hij de naam naar en cel op het aangemaakte blad.

verder wens ik niet alleen de naam mee te nemen maar ook drie waardes die ik achter de naam in cellen in vul.

 

is dit mogelijk ?

 

Voorbeeld:

 

 

 

 

Test tabbladen .xlsm

[alpha]

Verwijder alle macro's in je bestand, plaats onderstaande macro in module 1 en laat die uitvoeren door het klikken op de knop in blad1. Van de laatste naam in blad1 wordt dan een nieuw blad aangemaakt.

Sub Blad_toevoegen()
Dim a As Integer, x As Integer, y As Integer
a = 0
With Sheets(1)
x = .Range("A" & .Rows.Count).End(xlUp).Row
For y = 1 To Sheets.Count
If Sheets(y).Name = .Range("A" & x).Value Then
a = 1
End If
Next y
End With
If a = 0 Then
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
With Worksheets(Worksheets.Count)
.Range("A1").Value = Sheets(1).Range("A" & x).Value
.Range("D7").Value = Sheets(1).Range("B" & x).Value
.Range("A14").Value = Sheets(1).Range("C" & x).Value
.Range("C17").Value = Sheets(1).Range("D" & x).Value
.Name = Sheets(1).Range("A" & x).Value
End With
a = 0
End If
End Sub

 

[Jasper]

Super! dit lijkt goed te werken!

 

als ik nu add doe maakt die een pagina aan. daarna vul ik de volgende naam en cijfers in en  druk ik weer add dan maakt die die aan :D.

 

kan je ook eerst meerdere namen invullen en dan in een keer meer tabbladen maken? (nu werkt die op volgorde. De laatste die ik ingevuld heb maakt die een tabblad van aan)

 

en kan ik ook cellen uitsluiten voor het maken van een blad. dat bijvoorbeeld cel A1, A10, A30 uitgesloten zijn van het maken van een tabblad. Hier wil ik namelijk en tekst plaatsen waar de groepsverdeling gescheiden wordt.

[Jasper]

8 minuten geleden, Jasper zei:

Super! dit lijkt goed te werken!

 

als ik nu add doe maakt die een pagina aan. daarna vul ik de volgende naam en cijfers in en  druk ik weer add dan maakt die die aan :D.

 

kan je ook eerst meerdere namen invullen en dan in een keer meer tabbladen maken? (nu werkt die op volgorde. De laatste die ik ingevuld heb maakt die een tabblad van aan)

 

en kan ik ook cellen uitsluiten voor het maken van een blad. dat bijvoorbeeld cel A1, A10, A30 uitgesloten zijn van het maken van een tabblad. Hier wil ik namelijk en tekst plaatsen waar de groepsverdeling gescheiden wordt.

het kan dan wel voorkomen dat cel A2 tot bijvoorbeeld A7 ingevuld is maar 8 en 9 leeg blijven. Weet niet of dat dan fout gaat als op A11 wel weer info staat waar een tabblad van moet komen?

[alpha]

Wat je vraagt kan allemaal.

Maar als je de macro goed bestudeert, dan zou je dat zelf moeten kunnen; zo moeilijk is dat niet.

Het is wat ál te gemakkelijk om zelf niks te doen en alles aan anderen over te laten.

Je hebt zelf n.a.v. mijn antwoord nog helemaal niks geprobeerd.

 

 

[alpha]

Nou, vooruit dan maar.

Maar volgende keer wel meer zelfwerkzaamheid aan de dag leggen aub. Op een vraag als deze bv: "het kan dan wel voorkomen dat cel A2 tot bijvoorbeeld A7 ingevuld is maar 8 en 9 leeg blijven. Weet niet of dat dan fout gaat als op A11 wel weer info staat waar een tabblad van moet komen?" kun je zelf gemakkelijk het antwoord vinden door dat te testen, voor die test hoef je zelfs geen extra code in te voeren.

 

Sub Blad_toevoegen()
Dim a As Integer, l As Integer, x As Integer, y As Integer
a = 0: x = 1
With Sheets(1)
l = .Range("a" & .Rows.Count).End(xlUp).Row
Do Until x > l
If Not (IsEmpty(.Range("a" & x))) Then
For y = 1 To Sheets.Count
If Sheets(y).Name = .Range("A" & x).Value Then
a = 1
End If
Next y
If a = 0 Then
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
With Worksheets(Worksheets.Count)
.Range("A1").Value = Sheets(1).Range("A" & x).Value
.Range("D7").Value = Sheets(1).Range("B" & x).Value
.Range("A14").Value = Sheets(1).Range("C" & x).Value
.Range("C17").Value = Sheets(1).Range("D" & x).Value
.Name = Sheets(1).Range("A" & x).Value
End With
End If
End If
a = 0: x = x + 1
If x / 10 = Int(x / 10) Then x = x + 1
Loop
End With
End Sub

 

 

 

10 januari 2018 aangepast door alpha

[Jasper]

het is me gelukt  

Sub Blad_toevoegen()
Dim a As Integer, maxRows As Integer, sheetNo As Integer
Dim volgNummerNaam As String
a = 0
With Sheets(1)
maxRows = .Range("G" & .Rows.Count).End(xlUp).Row
For sheetNo = 1 To Sheets.Count
If Sheets(sheetNo).Name = .Range("G" & maxRows).Value Then
a = 1
End If
Next sheetNo
End With
If a = 0 Then
For rowNo = 1 To maxRows
    volgNummerNaam = Sheets(1).Range("G" & rowNo).Value
    If volgNummerNaam = vbNullString Or volgNummerNaam = "" Or volgNummerNaam = "Volgnummer" Then
    Else
        If SheetExists(volgNummerNaam) Then
        Else
            CreateNewSheetAndInfo (rowNo)
        End If
    End If
Next rowNo
a = 0
End If
End Sub

Function CreateNewSheetAndInfo(rowNo As Integer)
    Worksheets("template").Copy After:=Worksheets(Worksheets.Count)
    With Worksheets(Worksheets.Count)
    .Range("J1").Value = Sheets(1).Range("G" & rowNo).Value
    .Range("I6").Value = Sheets(1).Range("H" & rowNo).Value
    .Range("J6").Value = Sheets(1).Range("I" & rowNo).Value
    .Range("K6").Value = Sheets(1).Range("J" & rowNo).Value
    .Range("A6").Value = Sheets(1).Range("C" & rowNo).Value
    .Name = Sheets(1).Range("G" & rowNo).Value
    End With
End Function

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet

     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

 

[kweezie wabbit]

Is daarmee je probleem opgelost en mogen we het topic afsluiten?

[Jasper]

Ja hij mag gesloten worden. bedankt voor alle hulp

[kweezie wabbit]

OK.

Succes nog.