Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1780to1784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA Tabellen auf Basis Liste einfügen
21.09.2020 15:29:14
Bernhard
Hallo,
vielleicht könnt ihr mir bei folgendem Problem helfen. Ich habe in einem Tabellenblatt eine Liste, bei der in Spalte A der Buchungskreis, in Spalte B der Gesellschaftsname und in Spalte C ein "x" steht, sofern diese Gesellschaft ausgewählt ist. Wenn die Gesellschaft nicht ausgewählt ist, dann bleibt die Zelle leer. Ich suche nun nach einer VBA Lösung, die mir für jede Gesellschaft, bei der in Spalte C ein "x" gesetzt ist, ein eigenes Tabellenblatt anlegt. Das Tabellenblatt soll nach dem Buchungskreis in Spalte A benannt werden und vor Neuanlage eines Tabellenblattes soll geprüft werden, ob für diese Gesellschaft das Tabellenblatt bereits vorhanden ist. Wenn es bereits vorhanden ist, erfolgt keine Doppelanlage.
Ich habe dazu bereits einen VBA-Code gegoogelt, den ich zugegebenermaßen nicht so ganz verstehe _
und daher nicht an meine Bedürfnisse anpassen kann. Der Code funktioniert grds wunderbar, prüft - wie auch von mir gewünscht - die Spalte C auf einen Eintrag und legt - sofern noch nicht vorhanden - ein neues Tabellenblatt an, allerdings mit dem Namen, der in Spalte C steht und nicht mit dem Namen in Spalte A. Außerdem würde ich den Code gerne so anpassen, dass nur bei einem Eintrag "x" in Spalte C ein Tabellenblatt angelegt wird und nicht bei jedem Eintrag.
Private Sub CommandButton2_Click()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Gesellschaften")
Dim c As Range
Application.ScreenUpdating = False
With Ws
For Each c In .Range("c4:c" & .Cells(.Rows.Count, "e").End(xlUp).Row)
If Not ExistiertBlattX(c.Text) Then
Wb.Worksheets("UVA Formularvorlage").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
Dazu kommt noch diese Funktion (bringe ich leider nicht in das "schöne" VBA Format für das Forum):
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
Super wäre dann noch, wenn der Code auch eine Prüfung beinhalten würde, dass ein ggf vorhandenes Tabellenblatt mit Namen des Buchungskreises aus Spalte A gelöscht wird, sofern in Spalte C kein "x" gesetzt ist, sodass ich am Ende immer nur für jene Gesellschaften ein eigenes Tabellenblatt habe, bei denen in der Liste in Spalte C ein "x" gesetzt ist.
Vielen Dank schon vorab für eure Hilfe!
Bernhard

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Tabellen auf Basis Liste einfügen
21.09.2020 16:04:45
peterk
Hallo
Etwas modifiziert aber ungetestet (Bitte Sicherungskopie erstellen)

Private Sub CommandButton2_Click()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Gesellschaften")
Dim c As Range
Application.ScreenUpdating = False
With Ws
For Each c In .Range("C4:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
If c.Text = "x" Then
If Not ExistiertBlattX(c.Offset(0, -2).Text, False) Then  'Name aus Spalte A
Wb.Worksheets("UVA Formularvorlage").Copy after:=Wb.Worksheets(Wb. _
Worksheets.Count)
ActiveSheet.Name = c.Offset(0, -2).Text
End If
Else
Call ExistiertBlattX(c.Offset(0, -2).Text, True) ' Blatt wird gelöscht
End If
Next c
.Activate
End With
Set Wb = Nothing: Set Ws = Nothing: Set c = Nothing
Application.ScreenUpdating = True
End Sub
Function ExistiertBlattX(BlattName As String, ToDelete As Boolean) As Boolean
Dim Ws As Worksheet
ExistiertBlattX = False
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name = BlattName Then
If ToDelete Then
Application.DisplayAlerts = False
Ws.Delete
Application.DisplayAlerts = True
Else
ExistiertBlattX = True
Exit For
End If
Next Ws
Set Ws = Nothing
End Function

Anzeige
AW: VBA Tabellen auf Basis Liste einfügen
21.09.2020 18:02:57
Bernhard
Hallo,
Sehr cool! Vielen Dank! Habe noch 2 Anpassungen gemacht, da beim 1. "If Not ExistiertBlattX" True (statt False) gesetzt werden muss und in der Function hat nach dem Else ein End If gefehlt. Jetzt passt es gut.
Bernhard

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige