folgendes Makro erstellt mir Automatisch neue Tabellenblätter, in Abhängigkeit der in Spalte A eingetragenen Werte. Dieses möchte ich jetzt so erweitern, dass alle Zeilen, deren Werte in A mit den Bezeichnungen der Tabellenblätter übereinstimmen, automatisch in die entsprechenden Blätter eingefügt werden. Da es immer verschiedene und sehr viele Tabellenblätter geben wird, möchte ich die Bezeichnung der Blätter nicht im Code vorgeben... Ich hoffe, jmd. hat eine Idee. Vielen Dank.
Tim
Sub neueBlätter()
Dim objSh As Worksheet
Dim rng As Range
With ActiveSheet
For Each rng In Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If Len(rng) Then
If IsValidSheetName(rng.Text) Then
If Not SheetExist(rng.Text) Then
Set objSh = .Parent.Worksheets.Add(After:=.Parent.Sheets(.Parent.Sheets.Count))
objSh.Name = rng.Text
End If
End If
End If
Next
End With
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Worksheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function
Private Function IsValidSheetName(ByVal strName As String) As Boolean
Dim objRegExp As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Global = True
.Pattern = "^[^\/\\:\*\?\[\]]{1,31}$"
.IgnoreCase = True
IsValidSheetName = .test(strName)
End With
Set objRegExp = Nothing
End Function