Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellenblätter automatisch erstellen aus Liste


Betrifft: Tabellenblätter automatisch erstellen aus Liste von: Busbeschleuniger
Geschrieben am: 21.11.2017 16:50:39

Hallo,

ich habe ein Problem, was ich gern mit VBA lösen würde und bisher im Forum nicht fündig geworden bin.
Für eine Arbeit soll ich eine Excel Datei erstellen, die sich automatisch aufbaut. Im ersten Tabellenblatt "Investliste" sind die vorhandenen Daten. Jetzt soll Excel aus jeder Zeile in der was steht, ein eigenes Tabellenblatt erstellen, welches dann so heißt wie die Spalte C "Projektnummer" vorgibt. Das habe ich auch hinbekommen.
Jetzt habe ich folgendes Problem:
Ich möchte jetzt in der Investliste unten ein neues Projekt einfügen und fülle damit eine weitere Zeile. Ich möchte jetzt aber nicht, dass er alle Projektdatenblätter wieder neu erstellt, sondern die Liste quasi abarbeiten und nur für die neu hinzugefügte Zeile ein neues Tabellenblatt mit der zugehörigen Projektnummer (Spalte C) erstellt. Ist das irgendwie möglich?
Ich würde mich über eine schnelle Antwort sehr freuen! :) Ich hoffe, es ist alles verständlich.

LG

  

Betrifft: AW: Tabellenblätter automatisch erstellen aus Liste von: Werner
Geschrieben am: 21.11.2017 17:03:12

Hallo,

da würde ich in der Investliste rechts neben den Daten, in einer freien Spalte per Code ein x eintragen, sobald das entsprechende Blatt angelegt ist. Die Spalte kann man ja ausblenden.

Beim Code zum erstellen der Blätter dann abfragen ob in der Zeile die bearbeitet wird in der Zusatzspalte ein x steht oder nicht. Wenn nein neues Blatt anlegen, wenn ja dann eben nicht.

Gruß Werner


  

Betrifft: Entweder was Werner vorschlägt,... von: Michael (migre)
Geschrieben am: 21.11.2017 17:31:47

...was ein sehr pragmatischer Ansatz ist (der tadellos funktioniert), oder, alternativ ohne zusätzliche Eintragungen im Tabellenblatt, strickst Du Dir einfach eine Überprüfung, ob das anzulegende Blatt evtl. schon existiert, bevor Du es anlegst. Schematisch:

Sub a()

    '...Dein Code zum Anlegen von Blättern
    'zzgl. Prüfung
    If Not ExistiertBlattX("DasJeweiligeTabellenblatt") Then
        'Blatt ist noch nicht vorhanden, dann anlegen
        'Dein Code
    End If
    '...usw
End Sub

Function ExistiertBlattX(BlattName$, Optional MappeName$) As Boolean
    Dim Wb As Workbook, Ws As Worksheet
    
    ExistiertBlattX = False
    If MappeName = "" Then
        Set Wb = ActiveWorkbook
    Else: Set Wb = Workbooks(MappeName)
    End If
    
    For Each Ws In Wb
        If Ws.Name = BlattName Then
            ExistiertBlattX = True
            Exit For
        End If
    Next Ws
    Set Wb = Nothing: Set Ws = Nothing
End Function
LG
Michael


  

Betrifft: AW: Entweder was Werner vorschlägt,... von: Busbeschleuniger
Geschrieben am: 22.11.2017 07:53:35

Hallo Michael,

ja es ist besser, wenn keine weiteren Eintragungen gemacht werden müssen, da auch andere diese Tabelle nutzen sollen.

Meine

Function sieht jetzt wie folgt aus:

Function ExistiertBlattX() As Boolean
    Dim Wb As Workbook, Ws As Worksheet
    
    ExistiertBlattX = False
    If "Projektdatenblätter.xslm" = "" Then
        Set Wb = ActiveWorkbook
    Else: Set Wb = Workbooks("Projektdatenblätter.xlsm")
    End If
    
    For Each Ws In Wb
        If Ws.Name = "" Then
            ExistiertBlattX = True
            Exit For
        End If
    Next Ws
    Set Wb = Nothing: Set Ws = Nothing
End Function
Allerdings zeigt er mir jetzt immer den Laufzeitfehler '438: Objekt unterstützt diese Eigenschaft oder Methode nicht' an. Wo liegt der Fehler?

Trotzdem schon mal vielen, vielen Dank! :)


  

Betrifft: AW: Entweder was Werner vorschlägt,... von: Busbeschleuniger
Geschrieben am: 22.11.2017 07:54:43

Achso, dass zeigt er immer für die Zeile For each Ws In Wb an


  

Betrifft: Du hast Funktionen nicht verstanden von: Michael (migre)
Geschrieben am: 22.11.2017 10:53:36

mein lieber Namenloser!

Schau Dir mein Beispiel nochmal an, und versuche es nachzuvollziehen; in der von mir geposteten Funktion musst Du nichts anpassen, Du kannst diese vermutlich so, wie sie ist, in Dein Projekt übernehmen. Du musst allerdings in Deinem Code, an der Stelle, wo Du ein Blatt anlegen willst, zunächst auf die Funktion Bezug nehmen; der Rückgabewert der Funktion entscheidet über Anlage oder Nicht-Anlage des Blattes.

LG
Michael


  

Betrifft: AW: Du hast Funktionen nicht verstanden von: Busbeschleuniger
Geschrieben am: 22.11.2017 11:54:06

Hallo Michael,

okay. Aber wie ich das jetzt in meinen Code übernehme, verstehe ich einfach nicht. Tut mir leid. Muss für meine Traineearbeit plötzlich mit Excel Programmierung beschäftigen und habe mir bisher alles selber zusammen geschustert. Der Anfang meines Codes sieht bisher so aus:

Sub Tabellenblätter()

Dim LastRow, i

LastRow = Sheets("Investliste").Cells(Rows.Count, "C").End(xlUp).Row

For i = 1 To LastRow
Sheets("1").Copy After:=Sheets(Sheets.Count) 'neues Tabellenblatt erzeugen
ActiveSheet.Name = Sheets("Investliste").Range("C" & i + 1) 'Tabellenblatt benennen

Wie füge da jetzt Prüfungsfunktion mit ein??
Du bist mir wirklich eine große Hilfe, vielen Dank.

LG Ronja ;-)


  

Betrifft: Einfach so... von: Michael (migre)
Geschrieben am: 22.11.2017 12:45:05

Ronja,

Sub Tabellenblaetter()

    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Investliste")
    Dim c As Range
    
    Application.ScreenUpdating = False
    With Ws
        For Each c In .Range("C1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
            If Not ExistiertBlattX(c.Text) Then
                Wb.Worksheets(1).Copy after:=Wb.Worksheets(Wb.Worksheets.Count)
                ActiveSheet.Name = c.Text
            End If
        Next c
        .Activate
    End With
    Set Wb = Nothing: Set Ws = Nothing: Set c = Nothing
End Sub

Function ExistiertBlattX(BlattName$, Optional MappeName$) As Boolean
    Dim Wb As Workbook, Ws As Worksheet
    ExistiertBlattX = False
    If MappeName = "" Then
        Set Wb = ActiveWorkbook
    Else: Set Wb = Workbooks(MappeName)
    End If
    For Each Ws In Wb.Worksheets
        If Ws.Name = BlattName Then
            ExistiertBlattX = True
            Exit For
        End If
    Next Ws
    Set Wb = Nothing: Set Ws = Nothing
End Function
Den gesamten Code übernehmen, ausführen musst Du nur die Sub Tabellenblaetter.

LG
Michael


Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter automatisch erstellen aus Liste"