Office: (Office 2019) Kontrollkästchen (mehrere) Makro kopieren, Problem: Zellen nicht gegenseitig überschreiben

Hallo zusammen,

ich arbeite gerade an einer Vereinfachung für Bestellungen.
Ich habe es hingekriegt, dass Kontrollkästchen an zu wählen sind und dann bestimmte Informationen kopiert werden. Jetzt habe ich das Problem, dass mehrere Kontrollkästchen anwählbar sein sollen und diese dann herüber kopieren und die Zellen nacheinander befüllt werden sollen.

Ergo: Ich will, dass wenn ich ein Kontrollkästchen anwähle die Daten unter die Festgeschriebenen Daten "XY" kopiert werden, ohne leere Zeilen dazwischen zu lassen. Kollegen sollten praktisch die Kästchen an und abwählen können ohne hässliche leere Zeilen in der Spalte A zu hinterlassen.

Hoffe ich hab mich einigermaßen klar ausgedrückt ;)

 

Du bist im falschen Forum. Bildbearbeitung ist ein anderes.
Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Ich baue keine Datei nach, die Zeit hat schon jemand investiert.

Bilder statt Datei | Excel ist sexy!
Eine hochgeladene Arbeitsmappe erhöht die Wahrscheinlichkeit, dass Du eine Lösung für Dein Problem erhältst.
Erstelle folglich bitte eine Demomappe, aus der deine Aufgabenstellung klar erkennbar ist und lade diese Mappe mit einem aussagekräftigen Dateinamen hoch.
Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm*, Forum* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
Es sollte ein aussagekräftiger Name sein.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten ändern. Schaue Datei
http://hajo-excel.de/gepackt/fremd/Datei_verschluesseln.zip
Bei Download beachte bitte: von unsicheren Servern file-upload lade ich keine Datei herunter (lt. Einschätzung meines Virenprogramms)

Das ist nur meine Meinung zu dem Thema.

 

Hi,

Aktivieren eines Kontrollkästchens
die erste freie Zelle (in Spalte A) kannst du wie folgt ermitteln und damit etwas in die betreffende Zelle schreiben:

Code:

    Dim lngErste As Long
    lngErste = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(lngErste, 1) = ........

Deaktivieren eines Kontrollkästchens
z.B. mittels Find-Befehl den betreffenden Eintrag suchen und dann diese Zelle löschen:

Code:

    Dim rngZelle As Range
    Set rngZelle = Columns(1).Find("DerSuchbegriff", lookat:=xlWhole)
    rngZelle.Delete shift:=xlUp

---

 

Hallo Ihr beiden, schon mal vielen lieben Dank für eure Antworten.

Ja das hast du natürlich absolut Recht, danke für den Hinweis.

Hier nochmal die Excel anbei.

Ich habe die "Makro" mit dem Makro aufnehmen tool, gemacht und habe ehrlich gesagt keine Ahnung wie ich den Code da einfügen soll, damit es passt. Einfach reinkopieren hatte nicht funktioniert...

Also nochmal zusammenfassend:
Ich hätte gerne, dass man die Kontrollfelder Produkt 1-4 an und abwählen kann. Zu jedem Produkt gibt es ein Unterprodukt was direkt mit dem "Hauptprodukt" "auftauchen" bzw. verschwinden soll, je nachdem ob man das Kontrollfeld anwählt oder abwählt.
Produkte können nur einmal auftachen, aber z.b. Produkt 1 und 4 bzw alle Produkte können bestellt werden.

Vielen lieben Dank für die Unterstützung!

 

Hallo,

gelöscht

 

Hi,

du benötigst nur ein einziges Makro für alle Kontrollkästchen, da die Produktbezeichnung auf dem Kontrollkästchen steht:

Code:

Sub ProduktBearbeiten()
' Kopiert aus "Produkttabelle" das Produkt mit zugehörigem Unterprodukt in Tabelle 1
    Dim lngErste As Long
    Dim rngSuche As Range
    ' erste freie Zeile in Spalte A ermitteln
    lngErste = Cells(Rows.Count, 1).End(xlUp).Row + 1
    ' bezieht sich auf das aufrufende Kontrollkästchen
    With ActiveSheet.Shapes(Application.Caller)
        ' Kontrollkästchen aktiviert
        If .DrawingObject.Value = 1 Then
            ' suche die Aufschrift in Spalte A im Blatt Produkttabelle
            Set rngSuche = Worksheets("Produkttabelle").Columns(1).Find(.DrawingObject.Caption, lookat:=xlWhole)
            ' kopiere die gefundene und die Zelle darunter
            Sheets("Produkttabelle").Range(rngSuche, rngSuche.Offset(1, 0)).Copy
            ' Werte beider Zellen in die erste freie Zelle und die Zelle darunter einfügen
            Cells(lngErste, 1).PasteSpecial Paste:=xlValues
            ' in Spalte B beider Zellen die SVERWEIS-Formel eintragen
            Range(Cells(lngErste, 2), Cells(lngErste + 1, 2)).Formula = "=VLOOKUP(" & Cells(lngErste, 1).Address(0, 0) & ",Tabelle1,2,FALSE)"
        Else
            ' suche die Aufschrift in Spalte A in aktivem Blatt
            Set rngSuche = Columns(1).Find(.DrawingObject.Caption, lookat:=xlWhole)
            ' gefundene Zelle und Zelle darunter in Spalte A und B löschen
            Range(rngSuche, rngSuche.Offset(1, 1)).Delete shift:=xlUp
        End If
    End With
End Sub

---

 

Perfekt, vielen lieben Dank!!!
Funktioniert perfekt!