VBA Excel - Tabellenblatt automatisch benennen

Pinky

Erfahrenes Mitglied
Hallo Tutorials.de,

ich habe eine Excel-Datei, welche eine Übersicht bez. diversen Klassen darstellen soll. Da diese Tabelle mehrere Jahre halten soll und die Klassen in dieser Zeit varriieren, möchte ich eine Funktion einbauen, welche genau die Anzahl Tabellenblätter erstellt, wie ich auch Kalssen habe.

Das klappt auch, kein Problem. Jedoch der kleine Schönheitsfehler ist, bei benennen per Schlaufe heissen meine Tabellen nur 1, 2, 3 ...! Ich will aber, dass die Tabellen Klasse 1, Klasse 2, Klasse 3 ... heissen! Wie geht das?

Code zum Tabellen automatisch erstellen:

Code:
Sub tabellen()
klassen = Sheets("KP Informationen").Range("B4") /Wieviele Klassen sind es? Ist da eingetragen
    
    Dim X As Long
    For X = 1 To klassen
        Sheets("Klasse 1").Select
        Sheets("Klasse 1").Copy After:=Sheets(2)
        Sheets("Klasse 1 (2)").Select
        Sheets("Klasse 1 (2)").name = X
    Next
End Sub

Vielen Dank für jegliche Hilfe
Pinky
 
Das beste ist hier nicht über den Namen, sondern über den Index zu gehen.

Code:
Sub tabellen()
klassen = Sheets("KP Informationen").Range("B4") /Wieviele Klassen sind es? Ist da eingetragen

    Dim X As Long
    For X = 1 To klassen
        Sheets(X).Copy After:=Sheets(X)
        Sheets(X + 1).Name = "Klasse" & X + 1
    Next
End Sub
 
Oh, danke, das hat super geklappt.

Wie kann ich nun aber die neuen Tabellen ans Ende stellen?

Vielen Dank
Pinky
 
In der Schleife oben werden die doch nach der Tabelle "Klasse X" erstellt. Also doch eigentlich immer am ende.
 
Liebe Leute,

bin leider ein absoluter Neuling in Sachen EXCEL...

ich habe ein ähnliches Problem:

Ich möchte, abhängig von einem Zellwert (A1) in Sheet 1, eine Anzahl von Sheets auf der Basis eines vorhandenen Sheets 3 neu erstellen (Kopien von Sheet 3).Die Namen der neuen Sheets stehen in einer Tabelle in Sheet 2, deren Länge sich natürlich nach dem Wert von A1 in Sheet 1 richtet. Die Namen werden also automatisch generiert und stehen in der Tabelle (also z.B. A3 : A10). Hab ich mich einigermaßen klar ausgedrückt?

Bin für Hilfe in dieser Angelegenheit sehr dankbar!
 
Hi,

ausgehend davon, dass sich die Anzahl in A1 (Sheet 1) und die Namen in Sheet 2 ab A1 befinden, kannst
du folgendes versuchen:
Code:
Public Sub NewTablesByName()
    Dim intAnzahl As Integer, intZaehler As Integer
    
    intAnzahl = CInt(Sheets(1).Cells(1, 1)) ' Anzahl auf Sheet 1, Zelle A1
    
    For intZaehler = 1 To intAnzahl
        Sheets(3).Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(2).Cells(1, intZaehler)  ' Name auf Sheet 2 ab Zelle A1
    Next intZaehler
End Sub
Ciao
Quaese
 
Hallo,

danke für die schnelle Antwort - klappt auch wunderbar! :) Hab nur ein Kleinigkeit vergessen, wie ich jetzt bemerkt habe: Die in A1 eingebene Anzahl könnte sich ändern - mit dem Effekt, dass sich EXCEL beim neuen Aufruf des Makros beschwert, die Blätter gäbe es ja schon - ich bräuchte also noch als Ergänzung eine Überprüfung, ob das jeweilige Blatt bereits vorhanden ist, bevor es neu angelegt wird.

Erstmal aber shconmal vielen Dank für die Hilfe!
 
Hi,

du könntest jeweils die sheets-Kollektion durchlaufen und überprüfen, ob der aktuelle Name bereits
vorhanden ist. Anhand einer booleschen Variablen kannst du das weitere Vorgehen entscheiden.
Code:
Public Sub NewTablesByName()
    Dim intAnzahl As Integer, intZaehler As Integer
    Dim blnTest As Boolean
    Dim objSheet As Variant
    
    intAnzahl = CInt(Sheets(1).Cells(1, 1)) ' Anzahl auf Sheet 1, Zelle B8
    
    For intZaehler = 1 To intAnzahl
        blnTest = False
        
        For Each objSheet In Sheets
            If objSheet.Name = Sheets(2).Cells(1, intZaehler) Then
                blnTest = True
                Exit For
            End If
        Next objSheet

        If Not blnTest Then
            Sheets(3).Copy after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Sheets(2).Cells(1, intZaehler)  ' Name auf Sheet 2 ab Zelle B13
        End If

    Next intZaehler
End Sub
Ciao
Quaese
 

Neue Beiträge

Zurück