1. Der Code gehört in ein allgemeines Modul (Einfügen, Modul)
2. Dein Blatt mit dem Inhaltsverzeichnis heißt Themen.
Ich habe die Vorlage jetzt mal ausgeblendet und das Blatt "Inhalt" entfernt.
Datei im Anhang.
Gruß Ralf
Genau so sollte es sein!!!
DANKE
Kann man jetzt auch noch sagen, dass dieser Name der Tabelle immer als Überschrift auch in der Vorlage erscheint?
Also so hat jedes neue Tabellenblatt die Überschrift gleich wie die Beschriftung.
Dann erweitere das Makro wie folgt:
Sub FuegeBlaetterMitNamenEin()
Dim Zelle As Range
Application.ScreenUpdating = False
With Worksheets("Vorlage")
.Visible = True
For Each Zelle In Worksheets("Themen").Range("A1:A6")
.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Zelle
.Range("A1") = Zelle
End With
Next
.Visible = False
End With
End Sub
Gruß Ralf
Das passt nun alles super!
Aber vielleicht könnte es noch ein bisschen perfekter werden.
Wenn ich bereits einige neue Tabellen mithilfe des Makros erzeugt habe und mir dann noch
etwas einfällt und ich die Liste ergänze und dann wieder das Makro aufrufe, kommt eine
Fehlermeldung, dass es diese Namen bereits gibt.
Kann man da sowas einbauen, dass die vorhandenen ignoriert werden und trotzdem die
Neuen Tabellen erzeugt werden?
Moin mal wieder!
Und schon sind wir wieder bei meinem ersten Beitrag (#2).
Eigenzitat:
Zitat:Aber Achtung!
Tabellenblätter haben gewisse Konventionen.
(Länge, Sonderzeichen, keine doppelten Namen)
Daher muss eine vernünftige Fehlerbehandlung eingearbeitet werden.
Jetzt wieder zu Dir:
Zitat:Kann man da sowas einbauen, dass die vorhandenen ignoriert werden und trotzdem die
Neuen Tabellen erzeugt werden?
Ja man kann vor dem Kopiervorgang der Vorlage überprüfen, ob es bereits ein Blatt mit dem Namen gibt.
Ich mache dies mit einer UDF, die einen boolean-Wert (True oder False) zurückgibt.
Function SheetExists(sBook, sName) As Boolean
Dim x As Worksheet
On Error Resume Next
Set x = Workbooks(sBook).Sheets(sName)
If Err = 0 Then SheetExists = True
End Function
Hilft Dir dies bereits? :21:
(Ich schreibe aber gleich ein wenig mehr dazu …)
Gruß Ralf
Hier jetzt vollständig.
Fängt auch nicht erlaubte Tabellennamen ab:
Modul Modul1Option Explicit
Sub FuegeBlaetterMitNamenEin()
Dim Zelle As Range
Application.ScreenUpdating = False
With Worksheets("Vorlage")
.Visible = True
For Each Zelle In Worksheets("Themen").Range(Range("A1"), Range("A1").End(xlDown))
If Not SheetExists(Zelle.Text) Then
.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Zelle
.Range("A1") = Zelle
End With
End If
Next
.Visible = False
End With
End Sub
Function SheetExists(sName) As Boolean
Dim x As Worksheet
On Error Resume Next
Set x = Worksheets(sName)
If Err = 0 Then SheetExists = True
End Function
Gruß Ralf
DANKE! Klappt wunderbar!!