Tabellenblätter automatisch erstellen aus Liste

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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! :)

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

Beliebteste Forumthreads (12 Monate)

Tabellenblätter automatisch erstellen aus Liste

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

142 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblätter automatisch erstellen aus Liste

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

142 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread