Arbeitsblätter automatisch benennen
04.03.2008 08:06:00
J.
Ich habe hier zwei Makros, die mehrere Arbeitsblätter erstellen, und ihnen je nach dem was in einer Zelle steht, einen Namen zuordnen. Dabei durchsucht das Programm eine Liste , die ständig erweitert wird, und soll falls nicht vorhanden , aus einem Listeneintrag ein Tabellenblatt machen. Leider erhalte ich momentan nur den Laufzeitfehler 1004 wenn ein Eintrag der bereits besteht als neues Arbeitsblatt erstellt wird, und ich hätte es gerne so, dass das Programm, sofern bereits ein passendes Arbeitsblatt vorhanden ist, dieses Überspringt.
Hier ist mal der Programm Code
Sub NeuesBlattundName()
Dim rngC As Range, wks As Worksheet
With Sheets(1)
For Each rngC In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
On Error Resume Next
Set wks = Worksheets(rngC.Value)
On Error GoTo 0
If wks Is Nothing Then
rngC.EntireRow.Copy Worksheets.Add(after:=Sheets(Sheets.Count)).Cells(1, 1)
ActiveSheet.Name = CheckSheetName(ActiveSheet.Cells(1, 1))
End If
Set wks = Nothing
Next
End With
End Sub
Function CheckSheetName(strName As String) As String
Dim strNotAllowed As Variant
Dim n As Integer
'Im Tabellennamen nicht zulässige Zeichen
strNotAllowed = Array(":", "\", "/", "?", "*", "[", "]")
'unerlaubte Zeichen durch nichts ersetzen
For n = 0 To UBound(strNotAllowed)
strName = Replace(strName, strNotAllowed(n), "")
Next
'Namen auf 31 Zeichen begrenzen
CheckSheetName = Left(strName, 31)
End Function