Tabellen Automatisch erstellen und Umbenennen

Hallo Ihr Excel Profis
Ich habe mich an einer Aufgabe so festgefressen das ich nicht mehr weiterkomme darum bitte ich Euch um mithilfe.
Das Problem:
Auf ein Tabellenblatt habe ich ein Drehfeld mit einer Zelle (ZB a2)verknüpft und in der Zelle steht dann die Jahreszahl.
Außerdem habe ich dort noch ein Botton den Ich das gewisse Makro zuweisen möchte.
Dieses Makro soll dann den Wert aus der Zelle nehmen und ein Tabellenblatt erstellen,
hat auch alles soweit geklappt aber wenn ich ein zweites mal auf den Botton Drücke erstellt er mir eine an dere Tabelle und das soll vermieden werden.
Kurz und knapp: Beim Klick auf den Botton soll die Tabelle erstellt werden,sollte man ein zweites mal Klicken soll eine Fehlermeldung erscheinen das die Tabelle schon vorhanden ist.
Es müßte evt.mit einer Funktion gearbeitet werden, die prüft ob die Tabelle schon vorhanden ist.
Mein kläglicher Versuch sieht so aus:ohne Funktion


Sub Tabelle_erstellen()
zb = ActiveSheet.Index
Sheets("Tabelle1").Activate
Range("A23:L37").Copy
n = [a2].Value
Sheets.Add
For Each w In Worksheets
ActiveSheet.Name = n
ActiveSheet.Paste
On Error Resume Next
w.Name = n
zb = zb + 1
Next w
End Sub

Ich bedanke mich jetzt schon mal im vorraus und hoffe das das Makro vielen anderen dann ebenfalls nützlich sein kann.
Gruß
Juergen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Function schon_da(Blattname As String) As Boolean Dim s As String On Error Resume Next s = Worksheets(Blattname).Name If Err = 0 Then schon_da = True Err.Clear On Error GoTo 0 End Function Sub test() Const strBlattname As String = "Tabelle2" If schon_da(strBlattname) Then MsgBox "Mich gibbet schon" Else MsgBox "Mich gibbet noch nicht" End If End Sub

Sub Tabelle_erstellen() Dim wks As Worksheet Dim wks1 As Worksheet Set wks = Worksheets("Tabelle1") On Error Resume Next wks.Range("A23:L37").Copy n = wks.Range("A2") If n "" Then For Each w In Worksheets If w.Name = n Then MsgBox "Tabellenblattname schon vorhanden!" Exit Sub End If Next w Sheets.Add ActiveSheet.Name = n ActiveSheet.Paste Else MsgBox "Kein Tabellenblattname in Zelle A2!" End If End Sub

Beliebteste Forumthreads (12 Monate)

Tabellen Automatisch erstellen und Umbenennen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellen Automatisch erstellen und Umbenennen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread