Benötige Hilfe beim Tabellenblatt kopieren per VBA

[Ironangel]

Hallo zusammen,

ich habe bei mir in der Anwendung eine Schaltfläche, mit der ich das aktive Tabellenblatt kopiere und wieder einfüge.
Anbei der Code:

Code: Alles auswählen

ActiveSheet.Copy after:=Worksheets("Test")
ActiveSheet.Name = Format("Korrektur Plan" & " " & Range("M1") & ".KW " & Range("H1"))


Jetzt kann es vorkommen, dass das Tabellenblatt 4-5 neu abgespeichert werden muss. Vielleicht sogar öfter. Ich habe auch versucht mit

Code: Alles auswählen

& Worksheets.Count - 1


klar zukommen, aber da zählt mir Excel immer alle Blätter durch und fügt die nächste Zahl an. das möchte ich aber nicht. Ich hätte es gerne, dass das aktuelle Tabellenblatt plus nächste forlaufende Zahl kommt.

z.B.
Test
Test (1)
Test (2)
usw...

Kann mir da jemand auf die Sprünge helfen?

[Ralf A]

Hi,

meinst Du so?

Code: Alles auswählen

ActiveSheet.Copy after:=activesheet

[Ironangel]

Nein, ich vergebe ja einen Tabellennamen. Kopiere ich die Tabelle mit diesem Code, ist der Tabellenname ja gleich und dann bekomme ich eine Fehlermeldung, dass der Name schon existiert. Ich möchte den gleiche Tabellennamen nutzen allerdings mit einem Index. So wie es bei Excel auch ist, wenn man die gleiche Tabelle manuell kopiert.

[xysvenxy]

Gib dem Tabellenblatt direkt nach dem Kopieren einen Namen. Da das Blatt dann automatisch aktiv ist, kannst du einfach
Activesheet.Name = "[hier der Name]" &[Index]
Vorher kannst du ermitteln wie viele Sheets dieser Art es schon gibt in dem du das letzte Zeichen des vorigen Tabellenblattes ausliest.

[Ironangel]

Hm, wie lese ich das denn aus?

[xysvenxy]

In dem du mit der 'right' Anweisung arbeitest.

In der Annahme, dass das gerade kopierte Arbeitsblatt das letzte ist:
shts=sheets.count
zchn=right(sheets(shts-1).name,1)

[Ironangel]

Ok, danke für den Tipp. Ich versuche es mal hinzubekommen

[HKindler]

Hi,

ich hatte so etwas ähnliches einmal gebraucht:

Code: Alles auswählen

Function NameDatum(AlterName As String)
'gibt "AlterName 2017-03-22" oder "AlterName 2017-03-22 (2)" oder "AlterName 2017-03-22 (3)" oder ... zurück
Dim NeuerName As String     'beinhaltet den neuen Namen
Dim temp As String          'beinhaltet "AlterName 2017-03-22"
Dim i As Long               'Zähler
i = 1                                                   'mit 1 vorbelegen
temp = AlterName & " " & Format(Date, "yyyy-mm-dd")     '"AlterName 2017-03-22"
NeuerName = temp                                        'neuer Blattname wird mit Temp vorbelegt
Do While SheetExists(NeuerName)                         'Prüfung ob Blatt NeuerName existiert
    i = i + 1                                               'falls Blattname existiert, wird hochgezählt
    NeuerName = temp & " (" & i & ")"                       'Zahl hinten anhängen
Loop                                                    'zurück zur Prüfung
NameDatum = NeuerName                                   'neuen Namen zurück geben
End Function
Function SheetExists(strName As String) As Boolean
'gibt WAHR zurück, falls das Blatt strName existiert
    SheetExists = False
    On Error Resume Next                            'Fehlermeldung unterdrücken
    SheetExists = Not Sheets(strName) Is Nothing    'falls Blatt existiert wird Ausdruck WAHR
    'normalerweise sollte Fehlermeldung wieder eingeschaltet werden mit 'Not Sheets(strName) Is Nothing on error goto 0', wird hier aber mit 'end function' auch getan
End Function


[Ironangel]

Danke für die Hilfe. Ich habe mir etwas aus dem Netz gesuch, dass genau meinen Wünschen entspricht. Sogar noch besser als gewünscht.

Code: Alles auswählen

Dim strName As String
ActiveSheet.Copy After:=Sheets(Sheets.Count)
strName = InputBox("Name of new Sheet - or click OK to copy")
If Not strName = "" Then
    ActiveSheet.Name = strName
Else
    Exit Sub
End If
End Sub


[HKindler]

Hi,

das ist aber weit entfernt von deiner Ausgangssituation einer automatisierten Namensvergabe. Aber was soll's, wenn's dich glücklich macht...
Gut, dass ich mir nicht die Mühe gemacht habe meinen Code auf deine Wünsche anzupassen!

[DerHoepp]

Danke für die Hilfe. Ich habe mir etwas aus dem Netz gesuch, dass genau meinen Wünschen entspricht. Sogar noch besser als gewünscht.

Moin,

aber der gezeigte Code hat doch nix mit dem geschilderten Problem zu tun, zumindest hab ich das anders verstanden.

Viele Grüße
derHöpp