Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1908to1912
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
Inhaltsverzeichnis

Excel Newbie Problem

Excel Newbie Problem
08.12.2022 10:24:06
Julian
Hallo,
ich habe ein Problem mit einer Aufgabenstellung:
Datei: https://www.herber.de/bbs/user/156589.xlsx
Folgende vermeintlich einfache Aufgabe:
Prüfe in Tabellenblatt Aggreg3 in jeder Zeile, welche beschrieben ist, ob in Spalte G eine 1 oder eine 0 steht.
Bei einer 1 erstelle ein neues Tabellenblatt mit dem Namen aus Spalte E. Sollte das Tabellenblatt schon vorhanden sein, erstelle kein neues.
Ich bekomme das leider nicht hin. Kann mir da jemand weiterhelfen?
Vielen lieben Dank!
Julian

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel Newbie Problem
08.12.2022 10:50:27
ralf_b

Sub erstelleblaetter()
Dim i&, ws As Worksheet
i = 2
Do While Worksheets("Aggreg3").Cells(i, "G")  ""
If Worksheets("Aggreg3").Cells(i, "G").Value = 1 Then
Set ws = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
On Error Resume Next
ws.Name = Worksheets("Aggreg3").Cells(i, "E").Value
If Err.Number > 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
End If
i = i + 1
Loop
End Sub

AW: Excel Newbie Problem
08.12.2022 10:51:42
ChrisL
Hi
Noch eine Variante:

Sub t()
Dim lngZeile As Long, wks As Worksheet
With ThisWorkbook.Worksheets("Aggreg3")
For lngZeile = 2 To .Cells(.Rows.Count, 7).End(xlUp).Row
If .Cells(lngZeile, 7) = 1 Then
For Each wks In ThisWorkbook.Worksheets
If wks.Name = .Cells(lngZeile, 5) Then Exit For
Next wks
If wks Is Nothing Then
Set wks = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wks.Name = .Cells(lngZeile, 5)
End If
End If
Next lngZeile
End With
End Sub
cu
Chris
Anzeige
und nochmal mit umgekehrter Logik
08.12.2022 11:14:17
MCO
Hier noch eine Variante, die erst prüft, ob vorhanden und dann einfügt.
Außerdem wird nicht zeilenweise durchlaufen sondern alle gefüllten Zellen in Spalte. Damit ist der Bereich sauberer begrenzt, Leerzellen werden sofort ignoriert.

Sub neue_TABs()
On Error Resume Next
Dim act_sh As Worksheet
Dim new_sh As Worksheet
Set act_sh = ActiveSheet
For Each cl In act_sh.Range("G:G").SpecialCells(xlCellTypeConstants)
If cl = 1 Then
Set new_sh = Sheets(act_sh.Cells(cl.Row, "E").text) 'Fehler, wenn nicht vorhanden.
If err.Number > 0 Then
Set new_sh = ActiveWorkbook.Sheets.Add(after:=Sheets(ActiveWorkbook.Sheets.Count))
new_sh.Name = act_sh.Cells(cl.Row, "E")
err.Clear
End If
End If
Next cl
End Sub
Gruß, MCO
Anzeige
AW: und nochmal mit umgekehrter Logik
08.12.2022 11:45:35
Julian
super. hat geklappt. vielen lieben dank! Ich werde mir das jetzt mal anschauen und versuchen, daraus zu lernen!! danke an alle, die geholfen haben!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige