ich habe an folgender Aufgabe zu nagen.
Schritt 1: Ich habe eine Ausgangstabelle(Name=Verteilung) und möchte für jeden Wert aus Spalte A (ab Zeile 2) ein neues Arbeitsblatt anlegen, insofern der Wert erstmalig auftritt.
Dieses AB benenne ich dann mit Cell + dem Zellenwert.
Zudem Füge ich dabei jeweils die Überschrift ein, indem ich aus der Ausgangstabelle die ersten Werte der Spalten E,F und H in das neu erstellte AB kopiere.
Soweit so gut. Das funktioniert schon prima! Dazu ist auch der Code unten aufgeführt.
Schritt 2: Nun mein Problem. Ich möchte zusätzlich die Werte aus den Spalten E, F und H aus den Zeilen die in Schritt 1 durchgegangen werden in das richtige AB in Spalte A, B und C in die erste freie Zeile kopieren. Dabei kommen aber die gleichen Werte in Spalte A mehrfach vor. Es muss jedoch dann das richtige AB angesteuert werden, welches ich schon in Schritt 1 erstellt habe.
Ich hoffe mir kann jmd bei dieser Herausforderung helfen! :) Danke!
Gruß Cirby
Bisheriger Code:
Sub ArbeitsblätterÖffnenUndÜberschriftenEinfügen()
Dim rngZelle As Range, _
rngBereich As Range, _
wb As Workbook
Dim i2 As Integer
Dim iIndex As Integer
Dim Bool As Boolean
Set wb = ThisWorkbook
Set rngBereich = wb.Sheets("Verteilung").Range("A2:A10000")
iIndex = wb.Sheets("Verteilung").Index
For Each rngZelle In rngBereich
For i2 = 1 To Worksheets.Count
If Worksheets(i2).Name = "Cell" & rngZelle.Value Then
Bool = True
Exit For
Else
Bool = False
End If
Next i2
'neue Arbeitsblätter mit Zellenbezeichnung versehen und Überschriften eintragen
If Bool = False Then
If rngZelle "" Then
wb.Sheets.Add after:=wb.Sheets(iIndex)
iIndex = iIndex + 1
ActiveSheet.Name = "Cell" & rngZelle.Value
With Worksheets("Verteilung")
.Cells(rngZelle.Column, 5).Copy
ActiveSheet.Range("A1").PasteSpecial xlPasteValues
.Cells(rngZelle.Column, 6).Copy
ActiveSheet.Range("B1").PasteSpecial xlPasteValues
.Cells(rngZelle.Column, 8).Copy
ActiveSheet.Range("C1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
End If
End If
Next rngZelle
End Sub