Gruppe
Allgemein
Bereich
Arbeitsblatt
Thema
Tabellenblatt kopieren und dreistellig fortlaufend numerieren
Problem
Wie kann ich auf Schaltflächendruck ein Tabellenblatt kopieren und für dieses eine dreistellige fortlaufende Numerierung vergeben? Bereits vergebene Namen dürfen sich auch dann nicht wiederholen, wenn die Blätter inzwischen gelöscht wurden.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub NeuesBlatt()
Dim wks As Worksheet
Dim nme As Name
Dim iNme As Integer
Dim sNme As String
For Each nme In ThisWorkbook.Names
sNme = Right(nme.Name, 3)
If Len(sNme) = 3 And IsNumeric(sNme) Then
If CInt(sNme) > iNme Then
iNme = CInt(sNme)
End If
End If
Next nme
With ThisWorkbook
.Worksheets("Muster").Copy after:=.Worksheets(.Worksheets.Count)
End With
ActiveSheet.Name = "A" & Format(iNme + 1, "000")
Set nme = ActiveWorkbook.Names.Add( _
Name:="WKS" & Format(iNme + 1, "000"), _
RefersTo:=Range("A1"), _
Visible:=False)
End Sub