Dynamisch Excel Tabellenblätter adden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Target.Column = 1 And Target.Row > 1 Then If Target "" Then For Each Worksheet In ThisWorkbook.Worksheets If Worksheet.Name = Target Then MsgBox "Das Blatt " & Target & " gibt es schon." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If Next Worksheet Worksheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = Target End If End If End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Target.Column = 1 And Target.Row > 1 Then If Target "" Then If Target = Target.Offset(, 1) Or Target.Offset(, 1) = "" Then For Each Worksheet In ThisWorkbook.Worksheets If Worksheet.Name = Target Then MsgBox "Hinweis: Das Blatt " & Target & " gibt es schon." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If Next Worksheet Worksheets.Add after:=Worksheets(Sheets.Count) ActiveSheet.Name = Target Target.Offset(, 1) = Target Else For Each Worksheet In ThisWorkbook.Worksheets If Worksheet.Name = Target Then MsgBox "Hinweis: Das Blatt " & Target & " gibt es schon." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If If Worksheet.Name = Target.Offset(, 1) Then Worksheet.Name = Target Target.Offset(, 1) = Target Exit For End If Next Worksheet End If End If End If End If End Sub

Hallo,
ich habe keine Ahnung was du machst - bei mir macht das Makro genau das was es soll.
-entweder ein neues Blatt anlegen, mit dem Namen der in Spalte A eingetragen wird
-sollte ein derartiges Blatt schon vorhanden sein, dann kommt die Message Box
-wird ein Blattname in Spalte A überschrieben, dann wird der Name des Blattes (der in Spalte B steht) geändert
-sollte ein Blatt mit dem Namen (der in Spalte A geändert wurde) schon vorhanden sein, kommt die Message Box
ein Fehler kommt bei mir nicht.
Nimm mal meine hochgeladene Datei. Lösch alle Blätter bis auf Tabelle1. Lösch alle Einträge in Spalte A und in Spalte B
Und jetzt fängst du mal an. Dann schreibst du mir, was du genau, Schritt für Schritt gemacht hast, dass der Fehler aufgetreten ist.
Gruß Werner

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Target.Column = 1 And Target.Row > 1 Then If Target "" Then If Target = Target.Offset(, 1) Or Target.Offset(, 1) = "" Then For Each Worksheet In ThisWorkbook.Worksheets If Worksheet.Name = Target Then MsgBox "Hinweis: Das Blatt " & Target & " gibt es schon." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If Next Worksheet Worksheets.Add after:=Worksheets(Sheets.Count) ActiveSheet.Name = Target ActiveSheet.Range("A1") = "Inhaber" ActiveSheet.Range("B1") = "Kontostand" Target.Offset(, 1) = Target Else For Each Worksheet In ThisWorkbook.Worksheets If Worksheet.Name = Target Then MsgBox "Hinweis: Das Blatt " & Target & " gibt es schon." Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If If Worksheet.Name = Target.Offset(, 1) Then Worksheet.Name = Target Target.Offset(, 1) = Target Exit For End If Next Worksheet End If End If End If End If End Sub

Hallo,
so, und um einer möglichen weiteren Rückfrage wegen "verbotener Zeichen" im Blattname bzw. mehr als 31 Zeichen beim Blattnamen, jetzt noch mal neu mit einer Function /von Udo hier aus dem Forum).
Verbotene Zeichen werden durch Unterstriche ersetzt und der Blattname wird auf 31 Zeichen gekürzt.
Ein Punkt im Battnamen wäre zwar zulässig. Ich lass ihn aber trotzdem ersetzen, damit Excel da nicht ein Datum daraus macht.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strBlattname As String
If Target.Count = 1 Then
If Target.Column = 1 And Target.Row > 1 Then
If Target  "" Then
If Target = Target.Offset(, 1) Or Target.Offset(, 1) = "" Then
strBlattname = Target
strBlattname = LegalSheetName(strBlattname)
For Each Worksheet In ThisWorkbook.Worksheets
If CStr(Worksheet.Name) = strBlattname Then
MsgBox "Hinweis: Das Blatt " & strBlattname & " gibt es schon."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Next Worksheet
Worksheets.Add after:=Worksheets(Sheets.Count)
ActiveSheet.Name = strBlattname
ActiveSheet.Range("A1") = "Inhaber"
ActiveSheet.Range("B1") = "Kontostand"
Application.EnableEvents = False
Target.Resize(1, 2) = strBlattname
Application.EnableEvents = True
Else
strBlattname = Target
strBlattname = LegalSheetName(strBlattname)
For Each Worksheet In ThisWorkbook.Worksheets
If CStr(Worksheet.Name) = strBlattname Then
MsgBox "Hinweis: Das Blatt " & strBlattname & " gibt es schon."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
If CStr(Worksheet.Name) = CStr(Target.Offset(, 1)) Then
Worksheet.Name = strBlattname
Application.EnableEvents = False
Target.Resize(1, 2) = strBlattname
Application.EnableEvents = True
Exit For
End If
Next Worksheet
End If
End If
End If
End If
End Sub
Function LegalSheetName(strName As String) As String
Dim arrNotAllowed As Variant, n As Integer
'#### von Udo aus'm Pott ####
'Im Tabellennamen nicht zulässige Zeichen
arrNotAllowed = Array(":", ".", "\", "/", "?", "*", "[", "]")
'unerlaubte Zeichen durch "_" ersetzen
For n = 0 To UBound(arrNotAllowed)
strName = Replace(strName, arrNotAllowed(n), "_")
Next
'Namen auf 31 Zeichen begrenzen
LegalSheetName = Left(strName, 31)
End Function

Gruß Werner

Beliebteste Forumthreads (12 Monate)

Dynamisch Excel Tabellenblätter adden

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread