Hi zusammen!
Vielleicht könnt ihr mir helfen, den Code, den ich gefunden habe (füge ich unten an), um einen Punkt zu ergänzen.
(Vielleicht taugt er aber auch überhaupt nicht?)
Ausgangslage:
Blatt x ist die Zusammenführung von 10 Blättern.
- Blatt 1 liefert für die Gesamtansicht in Blatt x beispielsweise die ausgewählten Fleischgerichte
- Blatt 2 liefert für die Gesamtansicht in Blatt x beispielsweise die ausgewählten Fischgerichte
- Blatt 3 liefert für die Gesamtansicht in Blatt x beispielsweise die ausgewählten Desserts
- usw.
=> Blatt x dient quasi als Menüübersicht, welche Gerichte grade verfügbar sind.
Blatt x ist dabei quasi die Blanko-Zusammenfassung der Blätter 1 - 10, das aber nur die Kategorien (Fleisch, Fisch, Desserts) enthält.
D.h. die Kategorien sind bereits vorgehalten, nur leer.
Die Blätter (1-10, x) sind identisch aufgebaut.
Beispiel:
Es steht z.B. in Spalte C in Blatt x "Fleischgerichte", darunter ist es aber leer.
Dort soll der Zeilentransfer hin.
Ziel:
Ich stelle mir vor, dass Blatt 1 durchsucht wird.
Wenn gewünschtes Suchwort ("Fleischgerichte") in C gefunden, dann, wenn C nicht leer (also ein Fleischgericht steht drin), diese Zeile kopieren und unter das selbe Suchwort ("Fleischgerichte") in Blatt x einfügen.
Wichtig: Da in x bereits alle Kategorien als Blanko vorgehalten sind, ist es wichtig, dass die entsprechende Zeile so eingefügt wird, dass die anderen vorgehaltenen Zeilen nach unten verschoben werden.
Aus meinem Kopf umgangssprachlich formulierter Code:
1) Durchsuche Blatt 1 in Spalte C nach "Fleischgerichte".
2) Kopiere alle Zeilen darunter, die nichtleer sind in C
3) Kopiere Zeilen aus 2) unter das selbe Suchwort ("Fleischgerichte") in Blatt x.
Wie beim Copy-Pasten von ganzen Zeilen sollen die eingefügten Zeilen die vorigen "nach unten schieben".
Vielleicht hilft dieser Code als Start-Lösung, auf der man aufbauen kann?
Sub BedingteKopieZeilen()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 1
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 3).Value = "Ja" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(n)
n = n + 1
End If
Next Zeile
End With
End Sub
Danke vorab für eure Hilfe!
Herzlichen Gruß, Hendrik
|