AW: Danke für die Rückmelung + Erläuterungen...
22.01.2016 13:42:00
Michael
Hallo Laura!
Hier der Code nochmal in kommentierter Durchschau
Sub Idee()
Dim Liste As Range ' Einen Zellbereich für alle "Ideen" definieren"
Dim Idee As Range ' Eine einzelne Zelle
Dim BlattName As String ' Eine Variable für den Blattnamen (s.u.)
' Wo stehen die "Ideen", d.h. jene Zellen in die Du Texte (= Ideen) schreibst
' Hier: Die Ideenliste ist im Tabellenblatt mit Namen "Ideenliste" zu finden,
' ab Zelle A3 bis zur letzten gefüllten Zelle in A:A (damit bleibt die Länge
' der Liste dynamisch -->
With Worksheets("Ideenliste")
Set Liste = .Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
' Während des Makros stellen wir die Bildschirmaktualisierung sowie
' die automatische Formelberechnung aus (bessere Performance, kein Bildschirm-
' flackern... -->
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Wir gehen nun jedes Element der "Ideenliste", d.h. jede einzelne Zelle des
' Zellbereichs "Liste" (wie oben definiert in Blatt Ideenliste, von A3 bis Ax),
' durch und
' - übergeben den jeweiligen Zell-Text an die Funktion "NamenSauber" (diese
' Funktion ist ein eigenes "Makro" siehe weiter unten im Code)
' - die Funktion NamenSauber entfernt folgende Zeichen aus dem Zell-Text,
' sofern sie vorhanden sind: : / \ ? * [ ] - Diese Zeichen sind in Blatt
' Namen nicht erlaubt
' - danach prüfen wir mit der Funktion "BlattExistiert" (siehe weiter unten im Code)
' ob es schon ein Tabellenblatt mit diesem Namen gibt
' - wenn ja, passiert nichts
' - wenn nein wird das Tabellenblatt "Vorlage" ans Ende der Mappe kopiert (hinter
' das letzte Tabellenblatt
' - durch den Kopiervorgang wird das nun neue Tabellenblatt zum "aktiven Blatt",
' - d.h. wir setzen den Namen des aktiven Blattes gleich dem Inhalt der jeweiligen Ideen-
' Zelle (bzw. der Variablen BlattName)
For Each Idee In Liste
BlattName = NamenSauber(Idee.Text)
If Not BlattExistiert(BlattName) And Sheets.Count
' in der o.a. Prozedur wird daher "nichts" passieren.
For Each ws In ThisWorkbook.Worksheets
If ws.Name = BlattName Then
BlattExistiert = True
Exit Function
End If
Next
End Function
Function NamenSauber(BlattName As String) As String
' Den Zelltext auf max. 31 Zeichen kürzen (länger ist für
' Tabellen-Blätter nicht erlaubt
If Len(BlattName) > 31 Then BlattName = Left(BlattName, 31)
' Die Sonderzeichen " : / \ ? * [ ] " aus dem Zellinhalt entfernen
BlattName = Replace(BlattName, ":", "")
BlattName = Replace(BlattName, "\", "")
BlattName = Replace(BlattName, "/", "")
BlattName = Replace(BlattName, "?", "")
BlattName = Replace(BlattName, "*", "")
BlattName = Replace(BlattName, "[", "")
BlattName = Replace(BlattName, "]", "")
NamenSauber = BlattName
End Function
Schönes Wochenende und LG
Michael