Anzeige
Archiv - Navigation
1636to1640
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

Neue Tabellenblätter nach Wert in Zelle anlegen

Neue Tabellenblätter nach Wert in Zelle anlegen
09.08.2018 10:09:38
Lars
Hallo zusammen,
ich verzweifle so langsam.
Folgendes Problem: Ich habe ein Tabellenblatt mit ca. 200 Zeilen und 50 Spalten. In Spalte K stehen Werte von 1-60 (Werte kommen doppelt vor). Jetzt möchte ich gerne neue Tabellenblätter erzeugen, die nach den Werten in Spalte K benannt werden und dazu noch die entsprechende Zeile übernimmt.
Bei einem doppelten Wert soll nur ein Tabellenblatt erzeugt werden, in diesem dann aber entsprechend alle Zeilen, in dem der Wert aus Spalte K vorkommt, kopiert werden.
Ich hoffe das war einigermaßen verständlich und ihr könnt mir helfen:)
Vielen Dank schon einmal.

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Neue Tabellenblätter nach Wert in Zelle anleg
09.08.2018 10:44:11
Michael
Hallo!
Meine Annahme ist, dass im Quell-Blatt keine Überschriften stehen...
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim a, Dic As Object, i&, j&
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
With WsQ
a = .Range("A1:K" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = LBound(a, 1) To UBound(a, 1)
If Dic.exists(a(i, 11)) Then
With Wb.Worksheets(CStr(a(i, 11)))
For j = LBound(a, 2) To UBound(a, 2)
.Cells(.Rows.Count, j).End(xlUp).Offset(1, 0) = a(i, j)
Next j
End With
Else:
Dic.Add a(i, 11), ""
Wb.Worksheets.Add after:=Wb.Worksheets(Wb.Worksheets.Count)
With Wb.Worksheets(Wb.Worksheets.Count)
.Name = CStr(a(i, 11))
For j = LBound(a, 2) To UBound(a, 2)
.Cells(1, j) = a(i, j)
Next j
End With
End If
j = 0
Next i
.Activate
End With
Set Wb = Nothing: Set WsQ = Nothing: Erase a: Set Dic = Nothing
End Sub
LG
Michael
Anzeige
AW: Neue Tabellenblätter nach Wert in Zelle anleg
09.08.2018 11:04:34
Lars
Hi Michael,
Überschriften bestehen, allerdings sind die nicht wichtig und können gelöscht werden, da die Daten aus den Ziel-Tabellenblättern automatisiert weiter verarbeitet werden.
Das Makro funktioniert perfekt, vielen Dank für die schnelle Hilfe!
VG
Lars
AW: Gerne, Danke für die Rückmeldung, owT
09.08.2018 11:07:33
Michael

325 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige