Tabellenblätter um 1 erhöhen bzw. hochzählen
20.05.2009 13:03:38
Mike
Ich habe in einer Testdatei diesen Code hier aus dem Forum.
Ich habe mehrere Tabellenblätter nach zwei Kriterien geordnet
Blätter zur weiteren Verwendung
04.01.2009_1
05.01.2009_1
06.01.2009_1
06.01.2009_2
06.01.2009_3
usw.
Blätter in Wartestellung
04.01.2009A
05.01.2009A
06.01.2009A
06.01.2009B
06.01.2009C
usw.
Nun möchte ich ein Aktives Blatt über die Inputbox auf ein anderes Datum verschieben.
06.01.2008_1 und auf Wartestellung (06.01.2009D) setzen.
Wenn ich das Blatt von 06.01.2008_1 auf 06.01.2009_? verschiebe, wird die Zahl automatisch auf
die zu dem passend Datum um 1 (4) erhöht.
Wenn ich das Blatt aber von 06.01.2008_1 auf 06.01.2009(ohne den Unterstrich) setze, soll er
mir nicht die Zahl erhöhen, sondern den Buchstaben D bzw. den nächst freien Buchstaben zu dem
passenden Datum anfügen/bzw. erhöhen.
Es soll so sein, dass wenn hinter dem Datum der Unterstrich bleibt wird die Zahl um eins erhöht,
ist der Untersrich weg, wird der Buchstabe um eins erhöht.
Hoffe ich hab´s einigermaßen vernünftig erklärt und freue mich sehr auf Hilfe.
Danke! Gruß Mike
Irgenwie funktioniert der Upload nicht?!
Hier der Code:
Private Sub CommandButton1_Click()
'Vorlagenblatt kopieren, einfügen und umbenennen mit fortlaufender Nr.
Dim wbAktiv As Workbook
Dim wks As Worksheet
Dim intNameNr As Integer
Dim strKopieNeu As String
'Startext für Name Blatt-Kopie
strKopie = InputBox("Datum eingeben!", "Datum ändern...", Left(ActiveSheet.Name, 11))
'Name oder Nummer des Blatts vor dem eingefügt werden soll
Const strFormatNr As String = "0" 'Format für Zählziffer bei Namen
Set wbAktiv = ActiveWorkbook
'Nummer des Neuen Namens ermitteln - Es wird die höchste Zählnummer der Namen ermittelt
For Each wks In wbAktiv.Worksheets
With Application.WorksheetFunction
If LCase(Left(wks.Name, Len(strKopie))) = LCase(strKopie) Then
If IsNumeric(Mid(wks.Name, Len(strKopie) + 1)) Then
intNameNr = .Max(intNameNr, CLng(Mid(wks.Name, Len(strKopie) + 1)))
End If
End If
End With
Next
'Neuen Namen ermitteln
strKopieNeu = strKopie & Format(intNameNr + 1, strFormatNr)
'Neues Blatt anlegen und Name zuweisen
ActiveSheet.Name = strKopieNeu
End Sub