If Not BlattExists - zuweisung nicht aus einer UF-Box sondern Zelle B2 Dropdown

[WergibtmirRat]

Hallo, habe Schwierigkeiten beim anlegen neuer Tabellenblätter per VBA.
Ursprungs-Code lautet:

PHP-Code:

Private Sub CmdEingabe_Click()
Dim wksAktivSheet As Worksheet
Dim wksZiel As Worksheet
Dim intErsteLeereZeile As Long

Set wksAktivSheet = ActiveSheet
If Not BlattExists(CboKategorieSteuer.Text) Then Sheets.Add(Type:=xlWorksheet).Name = CboKategorieSteuer.Text
Set wksZiel = Worksheets(CboKategorieSteuer.Text)
    With wksZiel
    intErsteLeereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
...
Worksheets("alleDaten").Range("A1:G1").Copy .Range("A1:G1")
wksAktivSheet.Select
End With
End Sub 


Nun versuche ich die Zelle B2 im Tabellenblatt Tabelle1 (Start) anzusprechen.
Die Zelle B2 ist eine Dropdownzelle mit Bezug auf eine Datumliste in Spalte C desselben Tab.bl. Start
Habe versucht über Zellbereich Namensgebung "Kegelabenddatum" diese als Namensgeber für neue Tabellenblätter zu verwenden.
Der untere Code zeigt den Fehler. Typen unverträglich und stoppt hier mit dem Debugger:
Set wksZiel = Worksheets("Start").Range("b2")
Es wird ein Blatt mit Namen erstellt aber nicht der in der Zelle stehende
Die Spaltenüberschriften aus dem Tabellenblatt "Mustervorlage" wollte ich in dieser Funktion mit verarbeiten.

PHP-Code:

Private Sub CmdEingabe_Click()
Dim wksZiel As Worksheet
Dim intErsteLeereZeile As Long
' hier >BlattExists< habe ich den Bereichnamen eingefügt "Kegelabenddatum"
If Not BlattExists("b2.text") Then Sheets.Add(Type:=xlWorksheet).Name = ("b2.text") 'Name des neuen Tab.bl.
Set wksZiel = Worksheets("Start").Range("b2")
Worksheets("Mustervorlage").Range("A1:AK1").Copy("Kegelabenddatum").Range ("A1:AK1")
End Sub

Function BlattExists(BlattName As String) As Boolean
    On Error Resume Next
    BlattExists = Not ThisWorkbook.Worksheets(BlattName) Is Nothing
    On Error GoTo 0
End Function 


Ich bitte Euch um Hinweise wo der Fehler liegt bzw. was ich falsch gemacht habe und vielleicht Coderichtigstellung.
mfg

[schauan]

Hallo Frank,

habe erst mal nur schnell drüber geschaut und folgenden Fehler entdeckt:
Du dimensionierst die Variable als Worksheet und weist Ihr einen Range zu.
Außerdem benutzt Du das wksZiel dann für nix - außer für die Zuweisung.

Kegelabenddatum ist doch kein Bereichsname sondern ein Blattname?
Entsprechend müsste diese Zeile

Code:

Worksheets("Mustervorlage").Range("A1:AK1").Copy("Kegelabenddatum").Range ("A1:AK1")

so gehen

Code:

Worksheets("Mustervorlage").Range("A1:AK1").Copy Sheets("Kegelabenddatum").Range ("A1:AK1")

[WergibtmirRat]

...Kegelabenddatum...

Hallo André, doch in der Tat ist dieser lange Name der Name für die Zelle B2 im Tab.bl. Start.
Vorschläge werden sofort eingepflegt

Dank dir

mfg

[Steffl]

Auch Hallo,

das mit dem Tabellenblatt müßte meiner Meinung nach eher so lauten

Code:

If Not BlattExists(Worksheets("Start").Range("b2").text) Then Sheets.Add(Type:=xlWorksheet).Name = ("b2.text") 'Name des neuen Tab.bl.

[WergibtmirRat]

...das mit dem Tabellenblatt müßte...

Hallo Stefan, bin grad die Datei am suchen in meinem Hort von über 2000
wenn gefunden, werde ich den Codeschnipsel auch mit einpflegen und berichten.

Dank an die vielen freizeitaufopfernden Helfer'Z

mfg

[WergibtmirRat]

Hallo @all
So hab Datei gefunden, im Original zustand belassen ohne Änderung

anbei die besagte Datei

  Tabellexl.xlsm (Größe: 122,37 KB / Downloads: 2)

nochmals vielen Dank für die Mühen

mfg

[atilla]

Hallo zusammen,

Stefan, ich denke, Du hast noch einen Flüchtigkeitsfehler drin:

If Not BlattExists(Worksheets("Start").Range("b2").text) Then Sheets.Add(Type:=xlWorksheet).Name = ("b2.text") 'Name des neuen Tab.bl.

Frank, den rot gekennzeichneten Ausdruck auch wie am Anfang der Zeile:

Worksheets("Start").Range("b2").text)

eigenlich hier:
Worksheets("Start").Range("b2").Value

da es ja ein Zelleintrag und keine Combo-oder Textbox ist.

[WergibtmirRat]

Hallo Stefan & Atilla
habt Dank für eure Codeschnipsel

@Stefan
Worksheets("Mustervorlage").Range("A1:AK1").Copy Sheets("Kegelabenddatum").Range ("A1:AK1")

was ich kopieren will, spreche ich durch A1:AK1 im Tabellenblatt "Mustervorlage" an. Soweit ist das bei mir richtig
wohin ich einfügen möchte, versuchte ich durch einen aussagekräftigen Namen für die Zelle B2 im Tab.bl. "Start".
Da das neue Blatt den Zelleninhalt aus B2 von Tab.bl. "Start" als Namen kriegen soll. Das klappt nicht, ich weiss nicht wie ich das formulieren soll.

If Not BlattExists(Worksheets("Start").Range("b2").text) Then Sheets.Add(Type:=xlWorksheet).Name = ("b2.text")

...den rot gekennzeichneten Ausdruck auch wie am Anfang der Zeile... ...ein Zelleintrag und keine Combo-oder Textbox ist...

@Atilla
Danke für deine Aufmerksamkeit
Der erste Teil vom Code klappt nun, das ein neues Tabellenblatt mit Inhalt der Zelle B2 generiert wird.

Nun harpert es beim einfügen der Zeile 1 vom Tab.bl. "Mustervorlage"

Laufzeitfehler '1004'
Die Copy-Methode des Range-Obj. kann nicht ausgeführt werden.

Debugger zeigt Zeile:
Worksheets("Mustervorlage").Range("A1:AK1").Copy Sheets.Add(Type:=xlWorksheet).Name = Worksheets("Start2").Range("b2")

hier mein bisheriger Code

Code:

Private Sub Cmd_Erstelle_Click()
If Not BlattExists(Worksheets("Start").Range("b2")) Then Sheets.Add(Type:=xlWorksheet).Name = (Worksheets("Start").Range("b2"))
Worksheets("Mustervorlage").Range("A1:AK1").Copy Sheets.Add(Type:=xlWorksheet).Name = (Worksheets("Start")) '.Range("b2")
End Sub
Function BlattExists(BlattName As String) As Boolean
    On Error Resume Next
    BlattExists = Not ThisWorkbook.Worksheets(BlattName) Is Nothing
    On Error GoTo 0
End Function

Der Code unter der Zelle B2 "Start" klappt bei Auswahl in der Dropdownbox (Code von Karin (Beverly))

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strTabelle As String
    Dim bytErlaubt As Byte
    If Target.Count = 1 Then
      If Target.Address = "$B$2" Then
         Application.EnableEvents = False
         If Len(Target.Value) > 31 Then
            MsgBox "Name darf nicht mehr als 31 Zeichen beinhalten"
            Range("B2").ClearContents
         ElseIf InStr(Target, "/") > 0 Or InStr(Target, "?") > 0 Or InStr(Target, ":") > 0 _
            Or InStr(Target, "\") > 0 Or InStr(Target, "*") > 0 Or InStr(Target, "[") > 0 _
            Or InStr(Target, "]") > 0 Then
            MsgBox "Name enthät nicht zulässige Zeichen"
            Range("B2").ClearContents
         ElseIf Not IsError(Application.Evaluate(Target.Value & "!A1")) And strTabelle <> Target.Value Then
            MsgBox "Dieses Datum gibt es schon"
            Range("B2").ClearContents
         ElseIf ActiveSheet.Name <> Target.Value And Target <> "" Then
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Target.Value
         End If
         Application.EnableEvents = True
      End If
    End If
End Sub

Ich weiss nicht weiter, ihr vielleicht ?

mfg

[atilla]

Hallo Frank,

so müsste es gehen:

Private Sub Cmd_Erstelle_Click()
Dim neuSheet As Worksheet

If Not BlattExists(Worksheets("Start").Range("b2")) Then Sheets.Add(Type:=xlWorksheet).Name = (Worksheets("Start").Range("b2"))
Set neuSheet = Worksheets("Start").Range("b2")
Worksheets("Mustervorlage").Range("A1:AK1").Copy neuSheet.Range("A1")

End Sub

Der Inhalt der Zelle B2 in Blatt "Start" wird nicht geprüft!

[WergibtmirRat]

Hallo atilla,

...so müsste es...

leider nein.
Die Fehlermeldung

Laufzeitfeher 13
Typen unverträglich
Debugger stoppt bei:
Set neuSheet = Worksheets("Start").Range("b2")

anbei die Datei
  Tabellexli.xlsm (Größe: 128,6 KB / Downloads: 2)
Wo liegt da bloß der bek(n)ackte Fehler.. was chillen,>> Good stuff ggggggggggrrrrrrrrrrrrrrrrrr. :@
mfg