Tabblad Kopieren en automatisch de naam van een cel geven

[Roli21]

Hoi,

Ik ben een simpele gebruiker van excel en zou het volgende willen bereiken:
Ik zou graag (met een macro) een vooraf gemaakt tabblad automatisch willen kopieren en vervolgens de naam willen geven van een cel onder bijv. A1 tot stel A 300(elk tabblad zijn eigen naam).

Vooralsnog is het met alle informatie die ik op het forum heb gevonden niet gelukt.
Kan iemand mij vooral uitleggen hoe ik dit in Excel moet doen?

 

[Warme bakkertje]

Sub tst()
With Sheets("Blad1")
    For Each cl In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        Sheets("Blad2").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = cl
    Next
End With
End Sub

 

[Roli21]

Hoi Rudi,

Ik heb zitten zwoegen maar het lukt nog niet helemaal. De namen in het totaalblad, ook die daarna worden toegevoegd, moeten worden gekopieerd naar een nieuw werkblad. Nu krijg ik alleen een kopie.
Ik ben echt maar een huis tuin en keukengebruiker. Het bestandje heb ik bijgevoegd.

Ik doe waarschijnlijk iets verkeerd.


Bekijk bijlage Namen.xls

 

[Warme bakkertje]

Sub Kopieer()
With Sheets("Totaalblad")
    For Each cl In .Range("A[COLOR="#FF0000"]5[/COLOR]:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        Sheets("Werkblad").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = cl
    Next
End With
End Sub

 

[Roli21]

Hoi Rudi,

Zoals je ziet ben ik nu een eind op weg. Als nu de namen die ik toe wil voegen aan het totaalblad ook een eigen werkblad krijgen dan is het gelukt. Nu werkt het alleen voor het geheel en niet voor de namen die later toegevoegd worden. De macro kopieert wel maar niet met de juiste en nieuwe naam.

Tot nu toe dank voor je hulp.

Groet,
Roland

Bekijk bijlage Namen.xls

 

[Warme bakkertje]

Sub Kopieer()
With Sheets("Totaalblad")
    For Each cl In .Range("A5:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If Not WSExists(CStr(cl)) Then
            Sheets("Werkblad").Copy , Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = cl
        End If
    Next
End With
End Sub

Function WSExists(wsName As String) As Boolean
    On Error Resume Next
    WSExists = Worksheets(wsName).Name = wsName
End Function

 

[Roli21]

Hoi Rudi,

Werkt zoals gewenst. Super!!!

Dank voor je hulp.

gr.
Roland