Sub FuegeBlaetterMitNamenEin()
Dim Zelle As Range
Application.ScreenUpdating = FalseWith Worksheets("Vorlage")
.Visible = TrueForEach Zelle In Worksheets("Themen").Range("A1:A6")
.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Zelle
.Range("A1") = Zelle
EndWithNext
.Visible = FalseEndWithEndSub
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:1 Nutzer sagt Danke an RPP63 für diesen Beitrag 28 • Michael_91
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) AsBooleanDim x As Worksheet
OnErrorResumeNextSet x = Workbooks(sBook).Sheets(sName)
If Err = 0Then SheetExists = TrueEndFunction
Hilft Dir dies bereits? :21:
(Ich schreibe aber gleich ein wenig mehr dazu …)
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Hier jetzt vollständig.
Fängt auch nicht erlaubte Tabellennamen ab:
Modul Modul1
OptionExplicitSub FuegeBlaetterMitNamenEin()
Dim Zelle As Range
Application.ScreenUpdating = FalseWith Worksheets("Vorlage")
.Visible = TrueForEach Zelle In Worksheets("Themen").Range(Range("A1"), Range("A1").End(xlDown))
IfNot SheetExists(Zelle.Text) Then
.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Zelle
.Range("A1") = Zelle
EndWithEndIfNext
.Visible = FalseEndWithEndSubFunction SheetExists(sName) AsBooleanDim x As Worksheet
OnErrorResumeNextSet x = Worksheets(sName)
If Err = 0Then SheetExists = TrueEndFunction
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)