Neues Tabellenblatt wenn Zelle nicht leer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column > 1 Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub Sheets("Vorlagen").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ActiveSheet.Name = Left(Target.Value, 31) End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim ws As Object Application.ScreenUpdating = False If Target.Row >= 3 And Target.Column = 1 Then If MsgBox("Tabelenblatt mit Name """ & Target.Value & """ anlegen ?", _ vbYesNo, "Blatt Vorlage kopieren") = vbYes Then For Each ws In ActiveWorkbook.Sheets If LCase(ws.Name) = LCase(Target.Value) Then MsgBox "Blatt mit dem eingegeben Namen existiert bereits!" GoTo ende End If Next Worksheets("Vorlage").Copy before:=Worksheets("Vorlage") ActiveSheet.Name = Target.Value ' Me.Activate End If End If ende: Set ws = Nothing Application.ScreenUpdating = True End Sub

Hallo Robert,
hier eine Variante, die noch ein paar mehr Fehler bei der Zell-Auswahl und beim Blattnamen abfängt.
Gruß
Franz


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Fehler As Integer, ws As Object
On Error GoTo Fehler
Application.ScreenUpdating = False
If Target.Row >= 3 _
And Target.Column = 1 _
And Target.Cells.Count = 1 _
And Target.Range("A1").Value  "" Then
If MsgBox("Tabelenblatt mit Name """ & Target.Value & """ anlegen ?", _
vbYesNo, "Blatt Vorlage kopieren") = vbYes Then
For Each ws In ActiveWorkbook.Sheets
If ws.Name = Target.Value Then
MsgBox "Blatt mit dem eingegeben Namen existiert bereits!"
Target.Select
GoTo ende
End If
Next
Worksheets("Vorlage").Copy before:=Worksheets("Vorlage")
Fehler = 1
ActiveSheet.Name = Target.Value
Fehler = 0
'      Me.Activate
End If
End If
GoTo ende
Fehler:
Select Case Fehler
Case 1
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Me.Activate
Target.Select
Case Else
MsgBox "Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
End Select
ende:
Application.ScreenUpdating = True
End Sub

Tabellenblattname: Zusammenfassung A B C 1 Wert 2 Code Wert C5 C5 3 bbb bbb 1234 bbb 1234 4 aah aah 1234 aah 1234 Benutzte Formeln: B3: =INDIREKT("'"& $A3 &"'!C5") B4: =INDIREKT("'"& $A4 &"'!C5") C3: =INDIREKT("'"& $A3 &"'!" & C$2) C4: =INDIREKT("'"& $A4 &"'!" & C$2)

Beliebteste Forumthreads (12 Monate)

Neues Tabellenblatt wenn Zelle nicht leer

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

337 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Neues Tabellenblatt wenn Zelle nicht leer

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

337 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread