Tabellenblatt kopieren und umbennen

[krautblatt]

Hallo liebe Mitglieder,

ich kenne mich leider mit Makros nicht besonders gut aus, brauche diese aber für meine Bachelorarbeit. Deswegen habe ich im Internet ein wenig recherchiert und folgendes gefunden um ein Tabellenblatt automatisch zu kopieren (vom Tabellenblatt "Vorlage") und zu benennen (mit den Werten zwischen A1 und A10 vom Tabellenblatt "Übersicht"):

Code:

Sub tabellenblatterstellen()

For Each NeueTabelle In Worksheets("Übersicht").Range("A1:A10").Value 'alle Zellinhalte von A1 bis A10 durchgehen

   If Not IsEmpty(NeueTabelle) Then
   Sheets("Vorlage").Copy After:=Sheets(Sheets.Count) 'Vorlagetabelle als letztes Blatt in die Arbeitsmappe kopieren
   Application.DisplayAlerts = False 'Rückfrage (nach dem Löschen einer bestehenden Tabelle) unterdrücken
   'Versuch, eine gleichnamige Tabelle zu löschen; bei Fehler (= Tabelle ohnehin nicht vorhanden) einfach weitermachen
   On Error Resume Next: Sheets(NeueTabelle).Delete: On Error GoTo 0
   Application.DisplayAlerts = True 'Systemeldungen wieder einschalten
   Sheets(Sheets.Count).Name = NeueTabelle 'neue Tabelle (= letztes Blatt der Mappe) umbenennen
   End If
Next


End Sub

Funktioniert auch super :23:  Wenn ich nun aber meine Werte in der Spalte A vom Tabellenblatt Übersicht erweitere und das Makro erneut ausführe, werden die alten Tabellenblätter leider überschrieben. Nun meine Frage: wie muss ich dieses Makro erweitern, sodass es mir kontrolliert ob ein bestimmtes Tabellenblatt schon vorhanden ist und dieses dann nicht überschreibt, aber bei einem neuen Wert dieses trotzdem generiert?

[Werner.M]

Hallo,

einfachste Möglichkeit, so würde ich vorgehen, wäre es jeweils neben deinem Blattnamen zu erfassen, dass das Blatt bereits angelegt wurde. Beim Erstellen der neuen Blägger wird dann im Code noch abgefragt, ob das Blatt schon angelegt wurde.
Die Änderung im Code trägt jeweils in Spalte B, neben deinen Blattnamen den Vermerk ein "bereits angelegt", sobald ein Blatt mit diesem Namen angelegt wurde. Dieser Eintrag wird dann abgefragt. bevor das Blatt angelegt wird.

Code:

Sub tabellenblatterstellen()

For Each NeueTabelle In Worksheets("Übersicht").Range("A1:A10").Value 'alle Zellinhalte von A1 bis A10 durchgehen
   If Not IsEmpty(NeueTabelle) Then
       If NeueTabelle.Offset(0, 1) <> "bereits angelegt" Then
           Sheets("Vorlage").Copy After:=Sheets(Sheets.Count) 'Vorlagetabelle als letztes Blatt in die Arbeitsmappe kopieren
           Application.DisplayAlerts = False 'Rückfrage (nach dem Löschen einer bestehenden Tabelle) unterdrücken
           'Versuch, eine gleichnamige Tabelle zu löschen; bei Fehler (= Tabelle ohnehin nicht vorhanden) einfach weitermachen
           On Error Resume Next: Sheets(NeueTabelle).Delete: On Error GoTo 0
           Application.DisplayAlerts = True 'Systemeldungen wieder einschalten
           Sheets(Sheets.Count).Name = NeueTabelle 'neue Tabelle (= letztes Blatt der Mappe) umbenennen
           NeueTabelle.Offset(0, 1) = "bereits angelegt"
       End If
   End If
Next

Exit Sub

Gruß Werner

[RPP63]

ich kenne mich leider mit Makros nicht besonders gut aus, brauche diese aber für meine Bachelorarbeit.

Moin!
Ein wenig off topic und nur der Tatsache geschuldet, dass Du an einer wichtigen Arbeit bastelst:
Fange bitte erst gar nicht damit an, redundante Blätter zu entwickeln!
Sheets sind NICHT dafür gedacht, einen zeitlichen oder sonstigen Bezug (Artikel/Mitarbeiter) quasi-3D-artig darzustellen!
Du kannst Relationen mittels eindeutigem Schlüssel aufteilen, wenn die Tabelle ansonsten zu "breit" würden und viele Redundanzen beeinhaltet.
Befasse Dich mit "vernünftigen" Darstellungen, die dann später auch erheblich einfacher auszuwerten sind.
Dazu gehört bspw. eine "Druckansicht", die sich Daten mittels Verweis "zieht".
Für eine Auswertung dann ein Filter iVm Teilergebnis() und/oder ein Pivot-Table.
Die späteren Anwender der Datei (und wahrscheinlich auch Dein Prof) werden es Dir danken!
Gruß Ralf

[krautblatt]

Hallo Werner,

danke für die schnelle Antwort. Dein Vorschlag klingt logisch und ist bestimmt eine einfache Lösung. Bekomme aber leider beim Ausführen die Fehlermeldung Laufzeitfehler 424 und verweist dabei auf die Zeile 5 :91:

[krautblatt]

Moin Ralf,

danke für deinen Ratschlag. Leider muss ich bei meiner Arbeit mit mehreren Blättern arbeiten: Ich muss für jeden Raum eines Hauses die Wände, Türen, Fenster etc. erfassen und diesen dann Maße, U-Werte, Ausrichtungen etc. zuweisen und da jeder Raum eine verschiedene Anzahl an Elementen besitzt, finde ich es wäre am übersichtlichsten, wenn ich die Räume jeweils auf ein Blatt darstelle
Gruß Fabian

[RPP63]

Zeig mal, was Du bisher hast und ich zeige Dir, wie ich das meine.

[krautblatt]

Hab leider noch nicht viel, steckt noch in den Kinderschuhen :19: Versuche heute und morgen so viel wie möglich auszuarbeiten. Werde es dir dann zeigen.
Gruß Fabian

[RPP63]

Hab leider noch nicht viel, steckt noch in den Kinderschuhen :19: 

Um so besser, Fabian!  :19: 

Denn gebe ich die Hoffnung noch nicht auf, dass wir die Kuh vernünftig vom Eis kriegen!
Du solltest vielleicht, wenn erforderlich, auch die exakte Anforderung Deiner Aufgabe schildern.
Ich werde Dir sicherlich keine fertige Lösung erstellen, sondern Dir gemäß meiner Signatur ein paar Schubser geben.

Bis dahin!

[krautblatt]

Meine Aufgabe besteht darin ein Berechnungstool für eine Norm-Heizlast nach ÖNORM ..... mittels Excels aufzubauen. Und dafür muss ich u.a. alle Räume eines Hauses erfassen und denen verschiedenste Werte zuweisen (wie schon erwähnt U-Wert etc. und noch sonstige bauphysikalische Kennwerte). Dies sollte dann auch so formatiert sein, dass man es am Ende schön säuberlich und einheitlich ausdrucken kann.

Vielen Dank schon mal für eure Hilfe  :78:

[Helvetier]

Hallo
Nur nicht erfundenes neu erfinden:
www.forum-hausbau.de/data/DIN_EN_12831_Ausfuehrliches_Verfahren.xls
dafür aber sauber in Deiner Aufgabe anwenden.
Dafür braucht es aber keine Makros: kann alles mit Funktionen erledigt werden.
[url=http://www.forum-hausbau.de/data/DIN_EN_12831_Ausfuehrliches_Verfahren.xls][/url]