Clever-Excel-Forum

Seiten: 1 2

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

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")

(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

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.

(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

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

anbei die besagte Datei
[attachment=395]

nochmals vielen Dank für die Mühen

mfg

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.

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

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!

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[attachment=396]
Wo liegt da bloß der bek(n)ackte Fehler.. was chillen,>> Good stuff ggggggggggrrrrrrrrrrrrrrrrrr. :@
mfg

Seiten: 1 2

WergibtmirRat

schauan

WergibtmirRat

Steffl

WergibtmirRat

WergibtmirRat

atilla

WergibtmirRat

atilla

WergibtmirRat