Option Explicit
Private Sub Aufheben()
Dim WsTabelle As Worksheet
Dim BoVorhanden As Boolean
'* H. Ziplies *
'* 21.07.12 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/
For Each WsTabelle In Sheets
If WsTabelle.Name = Range("A1") Then
BoVorhanden = True
End If
Next WsTabelle
If BoVorhanden = False Then
Sheets.Add.Name = Range("A1")
End If
End Sub
Option Explicit
Sub MyNewSheet()
Dim MyName$, x&
MyName = Tabelle1.Range("A1").Text
On Error GoTo ErrExit
For x = 1 To Worksheets.Count
If Worksheets(x).Name = MyName Then
MsgBox "Dieses Blatt existiert schon", vbCritical
Exit Sub
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyName
Exit Sub
ErrExit:
MsgBox "es ist ein Fehler augfgetreten evtl. sind ungültige Zeichen im Namen", vbInformation
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
Application.DisplayAlerts = True
End Sub