Clever-Excel-Forum - Tabellenblätter nach Vorlage über Makro erstellen

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

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

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