AW: Blätter erstellen
17.08.2017 15:14:07
Michael
Hallo Walter!
Bitte sei bei Deiner nächsten Frage/Deinem nächsten Beitrag etwas sparsamer mit Information; HelferInnen im Forum mögen es gar nicht, wenn man Ihnen durch präzise aufbereitete Anfragen, zB um welche Blatt-Bereiche es konkret geht, die Arbeit abnimmt, sich das selbst einfach aus den Fingern zu saugen.
Zu Deiner Frage, im Prinzip so:
Sub EinBlattJeVerein()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsDaten As Worksheet, ws As Worksheet
Dim Vereinsliste As Range, Verein As Range
Dim Blatt$
Application.ScreenUpdating = False
' Auf welchem Blatt steht die Tabelle/Liste, anpassen:
Set WsDaten = Wb.Worksheets("Tabelle1")
With WsDaten
'Wo auf dem Blatt steht die Tabelle/Vereinsliste
'im Bsp in A1:A10, anpassen
Set Vereinsliste = .Range("A1:A10")
For Each Verein In Vereinsliste
'Vereinsnamen auf unerlaubte Zeichen/Länge prüfen...
Blatt = NamenSauber(Verein.Text)
'Wenn in der Mappe noch kein solches Blatt existiert...
If Blatt "" Then
If Not BlattExistiert(Blatt) Then
With Wb
'... der Mappe ein Blatt hinzufügen (Mappen-Ende)
'Der Blattname wird aus der jeweiligen Zelle übernommen
Set ws = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
ws.Name = Blatt
End With
End If
End If
Next Verein
End With
Set Wb = Nothing: Set WsDaten = Nothing: Set ws = Nothing
Set Vereinsliste = Nothing: Set Verein = Nothing
End Sub
Function BlattExistiert(BlattName As String) As Boolean
Dim s As Worksheet
BlattExistiert = False
For Each s In ThisWorkbook.Worksheets
If s.Name = BlattName Then
BlattExistiert = True
Exit Function
End If
Next
Set s = Nothing
End Function
Function NamenSauber(BlattName As String) As String
If Len(BlattName) > 31 Then BlattName = Left(BlattName, 31)
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
Beachte, dass Du im Makro "EinBlattJeVerein" noch den Namen für das Tabellenblatt, in dem die Daten stehen, sowie den Zellbereich, aus dem die Vereinsnamen gelesen werden, anpassen musst. Die beiden Funktionen dienen nur zur Vermeidung von Fehlern, denn Blätter mit gleichem Namen dürfen nicht mehrfach angelegt werden (zB wenn ein Verein öfter in der Liste vorkommt), und Blattnamen dürfen gewisse Zeichen nicht enthalten.
LG
Michael