Tildel kommando(Makro) til et kontrolelement

Du har 2 muligheder :
enten
dobbeltklik på alle 80 checkboxe og indsætte call Check i deres kode
eller
fjerne alle checkboxe, og erstat dem med formular checkbokse
disse kan så linkes til makroen Check

denne indsættes i et alm. modul:

Sub Check()
Set Sh = Sheets("ordrebekræftelse")
Application.ScreenUpdating = False
For t = 1 To 80
If Cells(t, "D") = True Then
If Sh.Cells(65500, "A").End(xlUp).Row < 10 Then rk = 10 Else rk = Sh.Cells(65500, "A").End(xlUp).Row + 1
Range("A" & t & ":C" & t).Copy Sh.Cells(rk, "A")
End If
Next
Application.ScreenUpdating = True
End Sub

Jeg har nu indsat ovennvænte i et modul, men jeg må indrømme, at jeg på dette punkt er rimelig novice, så jeg skal lige høre hvordan jeg opretter en formular checkboks.

Sammen måde som Kontrolelementcheckbox
Højreklik oppe i værktøjslinien
Vælg Formularer

husk under Formatering af element at linke til makroen Check
og linked celle skal være samme celle som boxen

Selvfølgelig..... har nu oprettet en formular checkbox i celle D4 og har også tildelt makroen "check" til elementet, og havde så regnet med, at cellerne a4..c4 blev overført til fanebladet "ordrebekræftelse", men det sker ikke - og det er selvfølgelig mig som mangler at udfører et eller andet - kan du hjælpe. Forstår heller ikke lige din sidste sætning ..."linked celle skal være samme celle som boxen".

Højreklik på boxen, vælg Formater Kontrolelement
skriv $D$4 i feltet Cellekæde

så vil der skiftevis stå SAND eller FALSK i celle D4
du kan evt formatere teksten til hvid, hvis den skal være usynlig

Det kører nu.... men der må være en "bøf" et eller andet sted, når f.eks. række 4 markeres, kopieres den til "ordrebekræftelse" - OK, men markerer jeg række 5, kopieres både række 4 og 5. Markerer jeg række 6 kopieres række 4, 5 og 6.

Er det muligt at tilføje en kommando således, at såfremt man "checker" f-eks. ræke 7 og finder ud af det var forkert, man fjerner fluebenet og så skal den kopierede række også fjernes på "odrebekræftelsen".

Glemte lige at skrive, at når jeg på nuværende tidspunkt fjerner et flueben, så overføres linien endnu engang til ordrebekræftelsen.

start lige med at udskifte din kode med denne
så ser jeg om jeg kan finde en bedre løsning

Sub Check()
Set Sh = Sheets("ordrebekræftelse")
Application.ScreenUpdating = False
For t = 1 To 80
If Cells(t, "D") = True Then
If Sh.Cells(65500, "A").End(xlUp).Row < 10 Then rk = 10 Else rk = Sh.Cells(65500, "A").End(xlUp).Row + 1
Range("A" & t & ":C" & t).Copy Sh.Cells(rk, "A")
End If
Next
Application.Wait 5
Range("D1:D80") = ""
Application.ScreenUpdating = True
End Sub

Til din orientering:
Har skiftet koden og nu overføres "kun" den række som markeres - fint.
men...
1. Fluebenet kan nu ikke ses når det er sat.
2. Kan ikke se om der står sandt eller falsk.
3. Når jeg unchecker fjernes linien ikke i ordrebekræftelsen, det ser også ud som om der altid står "sandt" - det blikker lige hurtigt og er så væk.

yep, det var det jeg mente med en bedre løsning
kikker på det

prøv denne i stedet :

Sub Check()
Set Sh = Sheets("ordrebekræftelse")
Application.ScreenUpdating = False
For t = 1 To 80
If Cells(t, "D") = True Then
If Sh.Cells(65500, "A").End(xlUp).Row < 10 Then rk = 10 Else rk = Sh.Cells(65500, "A").End(xlUp).Row + 1
Range("A" & t & ":C" & t).Copy Sh.Cells(rk, "A")
End If
Next
Application.Wait (Now + TimeValue("0:00:1"))
Range("D1:D80") = ""
Application.ScreenUpdating = True
End Sub

Har nu prøvet  - men stort set samme problematik

1. Fluebenet kan nu ikke ses når det er sat.
2. Kan ikke se om der står sandt eller falsk.
3. Når jeg unchecker fjernes linien ikke i ordrebekræftelsen, det ser også ud som om der altid står "sandt" - det blikker lige hurtigt og er så væk.

Flueben bliver sat, men slettes igen til slut i koden
der er jo ingen mening i at fluebenet bliver der, idet
du jo så skal fjerne det igen for at kunne sætte det
ved ny kopiering.
Grunden til jeg sletter det er at hvis du så sætter flere
flueben andre steder, vil der som koden er opbygget nu
blive kopieret linier som du ikke har valgt (som du selv var inde på tidligere)
Du kan evt. forlænge pause med denne
Application.Wait (Now + TimeValue("0:00:1"))
ændret til
Application.Wait (Now + TimeValue("0:00:2"))

Så er jeg med - og det virker fint.

Jeg er har forsøgt at ændre afkrydsningsfeltet til en knap istedet, da det ser lidt mere elegnt ud,  men til den kan jeg ikke lave en cellekæde - hmmmm - hvorfor ikke?

Nej knapper har ikke den funktion
der skal du bruge en makro til hver knap.
her er de 2 første
Sub Knap1()
Set Sh = Sheets("ordrebekræftelse")
Application.ScreenUpdating = False
If Sh.Cells(65500, "A").End(xlUp).Row < 10 Then rk = 10 Else rk = Sh.Cells(65500, "A").End(xlUp).Row + 1
Range("A1:C1").Copy Sh.Cells(rk, "A")
Application.ScreenUpdating = False
End Sub

Sub Knap2()
Set Sh = Sheets("ordrebekræftelse")
Application.ScreenUpdating = False
If Sh.Cells(65500, "A").End(xlUp).Row < 10 Then rk = 10 Else rk = Sh.Cells(65500, "A").End(xlUp).Row + 1
Range("A2:C2").Copy Sh.Cells(rk, "A")
Application.ScreenUpdating = False
End Sub

i knap 3 skal følgende linie
Range("A2:C2").Copy Sh.Cells(rk, "A")
ændres til
Range("A3:C3").Copy Sh.Cells(rk, "A")
osv.

her er pointene - mange tak for hjælpen.