Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Friedrichroda /
Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.

If Not BlattExists - zuweisung nicht aus einer UF-Box sondern Zelle B2 Dropdown
#1
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.TextThen Sheets.Add(Type:=xlWorksheet).Name CboKategorieSteuer.Text
Set wksZiel 
Worksheets(CboKategorieSteuer.Text)
    
With wksZiel
    intErsteLeereZeile 
= .Cells(.Rows.Count1).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(BlattNameIs 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
?mage
to top
#2
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")
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#3
(28.07.2014, 17:52)schauan schrieb: ...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
?mage
to top
#4
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.
Gruß Stefan
Win 7 / Office 2007
to top
#5
(28.07.2014, 18:21)Steffl schrieb: ...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
?mage
to top
#6
Hallo @all
So hab Datei gefunden, im Original zustand belassen ohne Änderung

anbei die besagte Datei

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

nochmals vielen Dank für die Mühen

mfg
?mage
to top
#7
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.
Gruß Atilla


...und ich gelobe Besserung...

to top
#8
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")

(28.07.2014, 20:58)atilla schrieb: ...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"
Zitat: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
?mage
to top
#9
Hallo Frank,

so müsste es gehen:

Zitat: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!
Gruß Atilla


...und ich gelobe Besserung...

to top
#10
Hallo atilla,
(29.07.2014, 14:12)atilla schrieb: ...so müsste es...
leider nein.
Die Fehlermeldung
Zitat:Laufzeitfeher 13
Typen unverträglich
Debugger stoppt bei:
Set neuSheet = Worksheets("Start").Range("b2")
anbei die Datei
.xlsm   Tabellexli.xlsm (Größe: 128,6 KB / Downloads: 2)
Wo liegt da bloß der bek(n)ackte Fehler.. was chillen,>> Good stuff ggggggggggrrrrrrrrrrrrrrrrrr. Angry
mfg
?mage
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Nicht über Zelle hinausschreiben fredo 10 135 24.03.2017, 10:33
Letzter Beitrag: fredo
  Wert einer Zelle als variable, welche den Wert einer anderen Zelle beeinflusst backflipnick 8 71 24.03.2017, 10:07
Letzter Beitrag: shift-del
  MessageBox liest nicht aktuellen Wert aus Zelle aus dertommy 5 68 22.03.2017, 11:55
Letzter Beitrag: dertommy
  2 Zellen bedingen das Auslesen einer 3. Zelle johnny9000 5 55 20.03.2017, 16:59
Letzter Beitrag: johnny9000
Video Formel und vtl. Eintrag von Hand in in einer Zelle? Tortipower 15 292 17.03.2017, 23:01
Letzter Beitrag: schauan
  2 Zellen bedingen die Auslese einer 3. Zelle johnny9000 3 68 16.03.2017, 17:14
Letzter Beitrag: johnny9000
  Eine Zelle mit Dropdown zum Scrollen Tino Muc 2 64 14.03.2017, 19:14
Letzter Beitrag: schauan
  Sverweis mit Mehrfachtreffern | Ergebnis in einer Zelle erhalten derOlli 26 385 14.03.2017, 14:23
Letzter Beitrag: derOlli
  Automatische Zuweisung der Mitarbeiter - Zuordnung über ein Intervall User_12345 15 479 03.03.2017, 20:59
Letzter Beitrag: schauan
  Zählen nur wenn andere Zelle nicht leer styriandi 3 93 03.03.2017, 19:41
Letzter Beitrag: GMG-CC

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste