Für jede Zeile neues Sheet
03.11.2018 12:17:46
Chris
ich habe ein Problem, was ich zum Teil schon mit den Antworten aus dem Forum lösen könnte, aber leider nicht ganz.
Also ich habe im Tabellenblatt mit dem Namen "Maßnahmen" ab der zweiten Zeile Maßnahmen aufgelistet.Die Maßnahmen werden anhand ihrer ID, die in Spalte B steht, unterschieden. In Spalte C steht ein Startdatum und in Spalte D ein Enddatum .
Nun möchte ich für jede ID ein neues Tabellenblatt erstellen -> das löse ich momentan dank " _ https://www.herber.de/forum/archiv/1132to1136/1135807_Fuer_jede_Zeile_neues_Sheet_und_Daten_transponieren.html" so:
Sub DatenpoolSepariertTransponieren()
Dim lngZ As Long
Dim wsDatenpool As Worksheet
'Name des Tabellenblattes, das die Liste enthält - bitte anpassen :
Set wsDatenpool = Worksheets("Abgeschlossene Maßnahmen")
With wsDatenpool
For lngZ = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
Sheets.Add.Name = .Cells(lngZ, 2) 'Name des neuen Blattes aus Spalte A
.Rows(1).Copy
Next
End With
Application.CutCopyMode = False
Set wsDatenpool = Nothing 'Speicher für Variable wieder freigeben
End Sub
Das Problem ist, dass manche Maßnahmen (mit der selben ID) über mehrere Zeilen gehen und deswegen eine Fehlermeldung kommt, da jedes Tabellenblatt unterschiedlich heißen muss (Dopplung). Filtern/Sortieren oder auch doppelte Maßnahmen löschen funktioniert hier vorab leider nicht, da ich gerne auch das Start und das Enddatum in das neue Tabellenblatt kopieren möchte. Allerdings brauche ich nur das erste Startdatum und das letzte Enddatum --> Vllt. nochmal zum Verständnis: Wenn eine Maßnahme mit dem gleichen Namen über 3 Zeilen geht, hat sie 3 Startdaten (Spalte C) und 3 Enddaten (Spalte D).
Excel sollte also "selber erkennen" über wieviele Zeilen die Maßnahme mit der selben ID geht, dann ein neues Tabellenblatt mit der ID als Name erstellen und anschließend das erste Start- und das letzte Enddatum in das entsprechende Tabellenblatt kopieren.
Ich hoffe das war einigermaßen nachvollziehbar erklärt. Ich bin für jeden Hinweis dankbar.
Viele Grüße,
Chris