cel van checkbox activeren

[Artemiss]

Hoi Excellers,

Ik heb een vraag en hoop dat jullie mij hiermee kunnen helpen.

Ik heb een excelbestand met meerdere checkboxen in kolom B. Naast iedere checkbox staat in kolom D een artikel dat naar de bestellijst moet worden gekopieerd als de checkbox word aangevinkt. De checkboxen hebben hun CellLink in kolom E.

Nu lukt het mij om met de volgende VBA-code per checkbox het gewenste te bereiken, maar ik weet niet precies hoeveel checkboxen er nog bij komen en volgens mij wordt de code onnodig lang als ik voor iedere checkbox de code moet herhalen.

Sub CheckBox1_Click()
' CheckBox1_Click Macro

    If ActiveSheet.Range("E5") = True Then
        With ActiveSheet.Range("D5").Copy
        Sheets("Bestelling").Select
        Range("A1000").Select
        Selection.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        End With
    End If
End Sub

Daarom wil ik graag de code aanpassen zodat hij werkt voor om het even welke checkbox waar deze code aan gekoppeld is. Wat ik geprobeerd hebt is het volgende:

Sub CheckBox2_Click()
' CheckBox2_Click Macro
    
    If ActiveCell.Offset(0, 3) = True Then
        With ActiveCell.Offset(0, 2).Copy
        Sheets("Bestelling").Select
        Range("A1000").Select
        Selection.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        End With
    End If
End Sub

Ik dacht dat dit zou werken, omdat ik ervan uitging dat als ik een checkbox aanvink de cel waarin deze checkbox staat actief werd, maar dat is dus niet het geval.
Kan iemand mij helpen om bij het aanvinken de onderliggende cel wel actief te krijgen, of kent misschien iemand een andere methode om de code voor iedere checkbox te laten werken.

Alvast bedankt voor de hulp,

 

[Roncancio]

Onderstaande code controleert alle aanwezige checkboxen en zet in het werkblad Bestellijst vanaf cel A1 en verder de bijbehorende artikelen.

Je zult dus eventueel zelf nog de locatie van de bestelling (werkblad en/of 1e cel) moeten aanpassen.

Sub Checkboxen()
Dim lRow As Long
    lRow = 1
    For Each chk In ActiveSheet.CheckBoxes
        If chk.Value = 1 Then
            Worksheets("Bestellijst").Range("A" & lRow).Value = Range(chk.LinkedCell).Offset(0, -1).Value
            lRow = lRow + 1
        End If
    Next
End Sub

De code hoeft niet aangepast te worden indien het aantal checkboxen verandert.

Met vriendelijke groet,


Roncancio

 

[Artemiss]

Beste Roncancio,

Hartelijk dank, dit is precies wat ik nodig heb.