Tabellenblätter nach Vorlage über Makro erstellen

[Araxx]

Hallo zusammen,

Ich möchte neue Tabellenblätter anhand einer Vorlage über ein Makro erstellen. Das Vorlagenblatt befindet sich in meiner Arbeitsmappe (Blatt Nummer 2). Im 3. Blatt steht eine Liste (A1:A100)  mit den Namen, der neuen Tabellenblätter. Sie werden also mit dem jeweiligen Namen aus der Liste benannt. Folgender Code bewerkstelligt dies:

Code:

Sub NeuesBlatt()
Dim i, z As Double
ActiveSheet.Range("A1:A100").End(xlDown).Offset(1, 0).Select
z = ActiveCell.Row
z = z - 1
For i = 1 To z
Sheets("Vorlage").Copy after:=Sheets(3)
ActiveSheet.Name = Sheets(3).Cells(z, 1).Value
z = z - 1
Next i

End Sub

Das funktioniert auch prima. Nun habe ich jedoch 2 Probleme um es etwas reibungsloser ablaufen zu lassen.


1. Wie schaffe ich es dass die erstellten Tabellenblätter ganz hinten (also rechts) im Verzeichnis erstellt werden. Habe es mit :

Code:

Sheets("Vorlage").Copy after:=ThisWorkbook.worksheets.Count

probiert, aber das funktioniert nicht.

2. Ich würde die Liste gerne nachträglich bearbeitbar machen. Also nach dem beispielsweise 10 Blätter bereits erstellt worden sind, neue in die Liste eintragen um diese ebenfalls zu erstellen. Wenn ich den Code erneut laufen lassen, erhalte ich die Fehlermeldung :400. Die neuen Blätter werden zwar erstellt, aber auch immer das Tabellenblatt Vorlage (2) erneut hinzugefügt. Wie könnte ich den Code entsprechend anpassen?

Vielen Dank schon mal im Voraus für eure Hilfe,

Gruß Araxx

[LuckyJoe]

Hi Araxx,

vielleicht so:

Code:

Sub NeuesBlatt()

   Dim i As Double
   Dim ws As Worksheet
   Dim wsExistiert As Boolean
   Dim r As Range

   Sheets(3).Activate
   For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
       wsExistiert = False
       For Each ws In Worksheets
           If Cells(i, 1) = ws.Name Then
               wsExistiert = True
               Exit For
           End If
       Next
       If Not wsExistiert Then
           Sheets("Vorlage").Copy after:=Sheets(ThisWorkbook.Worksheets.Count)
           ActiveSheet.Name = Cells(i, 1)
       End If
   Next
End Sub

[Araxx]

Hallo LuckyJoe,

vielen Dank für deine Antwort.

Beim Durchlaufen deines Codes erschein bei mir die Fehlermeldung "Typen unverträglich". durch eine minimale Anpassung des Codes, hat es dann aber funktioniert. Falls es noch jemand interessiert:

Code:

Sub NeuesBlatt()
   Dim i As Double
   Dim ws As Worksheet
   Dim wsExistiert As Boolean
   Dim r As Range
   Sheets(3).Activate
   For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
       wsExistiert = False
       For Each ws In Worksheets
           If Cells(i, 1) = ws.Name Then
               wsExistiert = True
               Exit For
           End If
       Next
       If Not wsExistiert Then
           Sheets("Vorlage").Copy after:=Sheets(ThisWorkbook.Worksheets.Count)
           ActiveSheet.Name = Sheets(3).Cells(i, 1).Value
       End If
       Next
End Sub

In Zeile 19 habe ich ActiveSheet.Name = Cells (i,1) mit ActiveSheet.Name = Sheets(3).Cells(i,1).Value    ersetzt.
Noch einmal vielen Dank für deine Hilfe,
Schöne Feiertage,
Gruß Johannes