Tabellenblatt kopieren einfügen Namen ändern

Einen wunderschönen letzten Arbeitstagen zusammen:-)
Folgender Sachverhalt:
In einer Arbeitsmappe werden Auswertungen gemacht. Dazu gibt es das "Controllingblatt", dass an vorletzter Stelle steht, und ein "vorlage"-blatt, welches kopiert werden muss, vor das Controllingblatt eingefügt werden muss und mit Namen "Potenzial - Nr" benannt werden muss.
Von vorne her hat man dann also angefangen mit Potenzial 1 die zig Potenzialblätter, dann Controlling, dann Vorlageblatt.
Mit einem Makro möchte ich jetzt, dass das kopieren der Vorlage + Benennen mit "Potenzial & nächste noch nicht vergebene Nummer" sowie aufsteigendes Sortieren der Tabellenblätter bis zum Blatt "Controlling" automatisch funktioniert;-)
Das wär toll...bekommen wir das hin?
Danke,
Lucia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lucia,
die folgende Prozedur erledigt die gewünschten Aktionen
Gruß
Franz


Sub PotenzialNeu()
'Vorlagenblatt kopieren, einfügen und umbenennen mit fortlaufender Nr.
Dim wbAktiv As Workbook
Dim wks As Worksheet
Dim intNrName As Integer
Dim strKopieNeu As String
Const strKopie As String = "Potenzial " 'Startext für Name Blatt-Kopie
Const strVorlage As String = "Vorlage" 'Name des Vorlageblattes
Const varEinfuegeBlatt As Variant = "Controlling" 'Name oder Nummer des Blatts vor _
dem eingefügt werden soll
Const strFormat As String = "0" 'Format für Zählziffer bei Namen
On Error GoTo Fehler
Set wbAktiv = ActiveWorkbook
'Nummer des Neuen Namens ermitteln
'Es wird die höchste Zählnummer der Namen ermittelt, die mit dem Kopie-Namen beginnnen
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
intNrName = .Max(intNrName, CLng(Mid(wks.Name, Len(strKopie) + 1)))
End If
End If
End With
Next
'Neuen Namen ermitteln
strKopieNeu = strKopie & Format(intNrName + 1, strFormat)
'Neues Blatt anlegen und Name zuweisen
wbAktiv.Worksheets(strVorlage).Copy before:=wbAktiv.Worksheets(varEinfuegeBlatt)
ActiveSheet.Name = strKopieNeu
Fehler:
With Err
If .Number  0 Then
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblatt kopieren einfügen Namen ändern

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

150 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblatt kopieren einfügen Namen ändern

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

150 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread