habe folgende Makros über das Forum erhalten, bin allerdings kein Profi.
Jetzt brauch ich allerdings einen Fachmann, ich blicke da nicht durch !
Das erstellen des neuen Tabellenblattes funktioniert. Habe sogar hinbekommen
wenn man in einer Zelle steht, wird automatisch der Name als TabellenblattName dann
verwendet.
Nun habe ich (wegen der Formatierung etc.) ein Musterblatt erstellt und möchte dieses als
Grundlage verwenden.
Ich habe mal aufgezeichnet:
Sheets("MusterTab").Select
Sheets("MusterTab").Copy Before:=Sheets(1)
Sheets("MusterTab (2)").Select
Sheets("MusterTab (2)").Name = "Walter"
ich möchte also diese MusterTab als neues Blatt kopieren und dann wie bisher verfahren,
den Namen übernehmen von der Zelle wo ich gerade stehe und dann einsortieren alph.
geht das ?
Hier das Makro:'------ NEUE Sheet mit sortieren -----------------------
Public Sub VK_Sheet_NEU_erstellen_mit_Sortieren()
Dim strNewSh As String, i As Integer
' strNewSh = InputBox("Name des neuen Blattes")
strNewSh = Blattname
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)
Function Blattname()
Dim Question As Byte
start:
'Blattname = InputBox("Name des neuen Blattes")
Blattname = InputBox("Name des neuen Blattes", "Eingabe", ActiveCell.Value)
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
'=======================================================
mfg Walter