Eigenschaften von Blatt 1 nach 2 gezielt übertragen

[Lulu_]

Hallo zusammen,

ich bastele an einen Code, ich muss dazu sagen, dass ich kein Profi bin, im gegenteil.

Folgendes soll geschehen:

Im Tabellenblatt "Spickzettel" sind Angaben aufgelistet. In der Spalte B kann ich die Filterfunktion nutzen und mir bestimmte Aktivitäten aussuchen. Diese kann eine Aktivität sein oder mehre (können durchaus auch alle ausgewählt werden). Habe ich mich für die Aktivitäten entscheiden, so beginne ich auf dem Blatt "Detalliert" in Spalte A bestimmte angaben untereinander zu machen. Wenn ich fertig bin, klicke ich auf ein Button der sich auf diese Seite rechts oben befindet (Heißt hier noch CommandButton21). Nun soll folgendes geschehen: Bedingt durch die getroffene Vorauswahl im Blatt "Spickzettel" sollen die Kreuze zusammengefasst übertragen werden und zwar für jede Zeile die eine Angabe enthält.

Beispiel:

Im Blatt "Spickzettel" wähle ich unter Aktivität "Kuchen backen und Aktivität 3". (Das ist alles was ich mit Blatt "Spickzettel" mache. Aktivität auswählen) Zu erkennen ist, dass ab derZelle D3 Kreuze gesetzt sind. Nun soll folgendes passieren: Diese Kreuze sollen als gesamt Menge betrachtet werden. Aktivität 3 hat 2 Kreuze, Aktivität "Kuchen backen" 3 Kreuze, da sich die Kreuzangaben überschneiden in Notwendigkeit C, "merken" wir uns insgesammt 4 Kreuze.( Das heißt alle Angaben unter "irgendwelche Angaben" in Blatt Detailliert werden 4 Kreuze haben.) Hätten wir soviele Aktivitäten ausgewöhlt, das alle Spalten ab D3 bis K_tabellenende Kreuze beinhaltet, dann hätten wir und für das nächste Blatt 6 Kreuze gemerkt)

Im Blatt "detailliert" schreiben ich unter "irgenwelche Angaben" die Angaben, die ich machen möchte. Ich schreibe erst Angabe1, dann Angabe2 usw. ich habe mich in diesen Beispiel für 4 Angaben entscheiden. Nun kommt das makro ins Spiel. Ich bin fertig mit meine Angaben (Hier sind es nur 6, könnten durchaus mehr sein) und klicke auf dem Commandbutton. Nun erscheinen die zusammengefasst Kreuze (ab D3), der Auswahl im Blatt Spickzettel.


Kompakt: Ich wähle also im Blatt Spickzetel aktivitäten aus. Es wird gemerkt in welche Spalten (ab D) Kreuze sind (v´bedingt durch die Auswahl, diese werden zu einer Zeile zusammen gefasst, insgesammt kann eine Zeile also 6 Kreuze beinhalten).
Nun mache ich in Blatt "Detailliert" angaben, ich schreibe dort in der Spalte A (ab A3) angaben. Wenn ich fertig bin klicke ich auf den Button, nun soll die gemerkte Zeile (die hier höchstens 6 Kreuze enthält) für jeden gemachten Eintrag eingesetzt werden.




das Problem: Das Programm reagiert nicht korrekt auf die Filterung. Wenn ich die Aktivitäten so auswähle wie sie der Reihe nach vorkommen, dann klappt es wunderbar. Wird beim Filtern jedoch eine Zeile "übersprungen", so hat das Makro Probleme diese Zeile darzustellen.

Zum Beispiel Kuchen backen steht in Zeile3, wähle ich diese (nur diese aus) funktioniert alles wunderbar. Wähle ich aber das nicht sondern nur "deftiges kochen" (was in Zeile 4 steht) so werden mir keine Kreuze angezeigt.
Wähle ich kuchen backen (Zeile 3), dann "deftiges kochen" (Zeile 4) und halte die Zeilenreihenfolge so funktioniert alles wunderbar. Sobald ich eine Zeile überspringe, wird diese ignoriert bzw bricht der Makro scheinbar ab.

Weißt jemand wie das behoben werden kann?

Die Beispiel-Datei mit Code findet ihr unter: [
Dateiupload bitte im Forum! So geht es: Klick mich!
]

Und hier stelle ich euch den genutzten Code zur Verfügung:

Code:

Private Sub CommandButton21_Click()

Dim i As Integer
Dim wks As Worksheet
Set wks = Worksheets("Detailliert")
With Worksheets("Spickzettel").Cells.SpecialCells(xlCellTypeVisible)
  For i = 4 To 11
    If Application.WorksheetFunction.CountIf(.Columns(i), "x") > 0 Then _
     wks.Cells(3, i).Resize(wks.Cells(wks.Rows.Count, 1).End(xlUp).Row - 2) = "x"
  Next
End With

Wäre super wenn dieses Problem gelöst werden könnte :26:

[schauan]

Hallo LuLu,

durch das Filtern wird der Bereich in mehrere Areas unterteilt, die jeweils zusammenhängenden sichtbaren Bereiche. Das Makro betrachtet nur das erste Area.
Selbiges fängt in Deinem Beispiel in Zeile 1 an und geht je nach gefilterter Spalte nur bis Zeile 2, den Überschriften.

Im Prinzip könntest Du die Areas so verarbeiten. Du musst aber aufpassen - wenn eine Spalte ausgeblendet ist, werden die Areas dadurch auch nochmal getrennt.
Du müsstest noch die Cells(3, ... variabel gestalten, damit die Ergebnisse in der Schleife For j ... sich nicht überschreiben. Falls es dazu fragen gibt, bitte nochmal melden.

Code:

Private Sub CommandButton21_Click()

Dim i As Integer
Dim wks As Worksheet
Set wks = Worksheets("Detailliert")
With Worksheets("Spickzettel").Cells.SpecialCells(xlCellTypeVisible).Areas
  For j = 1 To .Count
  For i = 4 To 11
    If Application.WorksheetFunction.CountIf(.Item(j).Columns(i), "x") > 0 Then
     wks.Cells(3, i).Resize(wks.Cells(wks.Rows.Count, 1).End(xlUp).Row - 2) = "x"
    End If
  Next
  Next
End With
End Sub

[Lulu_]

Hallo,

ersteinmal vielen Dank für die Antwort. Hab mich sehr gefreut.

Jetzt habe ich doch noch eine Frage... Wenn statt Filtern, die Auswahl mit Kreuze vor dem element getroffen werden soll, wie kann ich dies am geschicksten einbauen?

Ich habe an etwas gedacht wie

Code:

Sub Makro1()
    Dim i As Integer
    For i = 1 To 6
        If Sheets("Blatt1").Range("A" & i).Value = "x" Then
            'Hier müsste ich nun Teil 1 des Codes umschreiben, ohne SpecialCells(xlCellTypeVisible).Areas
        End If
    Next i
    End Sub

Aber die verknüpfung gelingt mir nicht ganz, dafür mangelt es an Erfahrung Kann mir hier jemand helfen?

Beispieldatei: [
Dateiupload bitte im Forum! So geht es: Klick mich!
]