ich möchte eine neue Tabelle erstellen, den Namen vergeben und dann alphab. einordnen,
könnte mir jemand helfen ?
gr Kurt P
Sub Sheet_in_Alphabet()
Dim strNewSh As String, i As Integer
strNewSh = InputBox("Name des neuen Blattes")
If strNewSh = Empty Then Exit Sub
With ThisWorkbook
For i = .Sheets.Count To 1 Step -1
If strNewSh > .Sheets(i).Name Then
Sheets.Add After:=.Sheets(i)
ActiveSheet.Name = strNewSh
Exit Sub
End If
Next
Sheets.Add Before:=.Sheets(1)
ActiveSheet.Name = strNewSh
End With
End Sub
Gruß Gerd
Sub Sheet_in_Alphabet()
Dim strNewSh As String, i As Integer
strNewSh = InputBox("Name des neuen Blattes")
If strNewSh = Empty Then Exit Sub
With ThisWorkbook
i = 1
'Anfangsbedingung
Do Until UCase(Left(.Sheets(i).Name, 1)) = "A"
MsgBox .Sheets(i).Name
i = i + 1
Loop
For i = i To .Sheets.Count
MsgBox .Sheets(i).Name
'Schlussbedingung - evtl. ändern
If .Sheets(i).Name Like "Tabelle*" Or .Sheets(i).Name Like "Sheet*" Then Exit For
If UCase(strNewSh)
Gruß Gerd
Function Blattname()
Dim Question As Byte
start:
Blattname = InputBox("Name des neuen Blattes")
If Blattname = Empty Then Exit Function
Do While ShExists(Blattname)
Question = MsgBox("Ein Blatt namens " & Blattname & " ist bereits vorhanden!" & vbCrLf _
& "Soll dieses gelöscht werden ?", vbYesNoCancel + vbQuestion)
If Question = vbYes Then
ThisWorkbook.Sheets(Blattname).Delete
ElseIf Question = vbCancel Then
Blattname = ""
ElseIf Question = vbNo Then
GoTo start
End If
Loop
End Function
Function ShExists(strNewSh)
On Error Resume Next
ShExists = Not ThisWorkbook.Sheets(strNewSh) Is Nothing
On Error GoTo 0
End Function
Gruß Gerd