Thema: Variantenauswahl per Makro

Hallo liebes Forum,
ich habe ein Problem und benötige euren kompetenten Rat.
Da eine Beispieltabelle mehr sagt als tausend Worte, habe ich euch eine Datei angehängt.
https://www.herber.de/bbs/user/100961.xlsx
Ich möchte über die Schaltflächen eine der vier Varianten auswählen. Der Zellbereich in der ausgewählten Spalte sollte dann in die Spalte "Favorit" geschrieben/kopiert werden.
Wenn ich mich über die Bedienung der Schaltflächen für eine andere Variante entscheide, sollte sich auch der entsprechende Inhalt in der Spalte "Favorit" ändern.
Wichtig ist, dass im Makro ein Zellbereich variabel angegeben werden kann. Die Tabelle ist nicht als Tabelle formatiert.
Mit welchem Makro muss ich die einzelnen Schaltflächen belegen?
Für jeden Tipp bin ich sehr dankbar!
Beste Grüße
T1M0

Hi,
schreibe dieses Makro in ein allgemeines Modul und verknüpfe die OptionsButton jeweils mit dem Makro.

Sub Kopieren()
Dim lngLetzte As Long
Dim intSpalte As Integer
With ActiveSheet.Shapes(Application.Caller)
intSpalte = Range(.TopLeftCell.Address).Column
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, intSpalte)), _
Cells(Rows.Count, intSpalte).End(xlUp).Row, Rows.Count)
Range(Cells(3, intSpalte), Cells(lngLetzte, intSpalte)).Copy
Range("A3").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
End Sub

---

Hallo!
Vielen Dank für die schnelle Hilfe!
Ich habe jedoch vergessen, ein wichtiges Kriterium mitzuteilen:
Wenn sich Einträge in der bevorzugten Variante ändern, soll sich das unmittelbar in der Favoritenspalte ändern. Das heißt ich benötige eine Art direkte Verknüpfung. Derzeit muss ich immer händisch den Schaltbutton bedienen damit die Änderung übernommen wird (die Favoritenspalte wird später für den Nutzer ausgeblendet und wird nur für weitere Berechnungen übertragen)
Das wird wohl die ganze Logik hinter dem Makro ändern. Sorry, hatte dieses Problem bei meiner ersten Anfrage nicht auf dem Schirm.
Kannst du/ihr mir weiterhelfen?
Danke und beste Grüße!
T1M0

Hi,
kopiere folgenden Code ins Codemodul des Tabellenblattes:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim optButton As OptionButton
Dim intSpalte As Integer
If Target.Row > 2 And Target.Column < 6 Then
If Target.Count = 1 Then
For Each optButton In ActiveSheet.OptionButtons
If optButton.Value = 1 Then Exit For
Next optButton
intSpalte = optButton.TopLeftCell.Column
If intSpalte = Target.Column Then
Application.EnableEvents = False
Cells(Target.Row, 1) = Target
Application.EnableEvents = True
End If
Else
MsgBox "Bitte nur 1 Zelle ändern"
End If
End If
End Sub

---

Klasse, vielen Dank!
Leider wird nun bei jedem Variantenwechsel die MsgBox "Bitte nur 1 Zelle ändern" angezeigt, da ja mehrere Einträge auf einmal kopiert werden. Besteht die Möglichkeit, dass die MsgBox nur dann erscheint, wenn man innerhalb der Spalte mehr als 1 Zelle kopiert?
Beste Grüße!

Hi,
ergänze diese Zeile:

    If Target.Row > 2 And Target.Column < 6 And Target.Column > 1 Then

---

Stark, jetzt ist es genauso wie ich es wollte!
Vielen herzlichen Dank!
Das Forum ist einfach nur der Hammer!
Beste Grüße!

Hallo liebes Forum,
ich habe ein Problem und benötige euren kompetenten Rat.
Da eine Beispieltabelle mehr sagt als tausend Worte, habe ich euch eine Datei angehängt.
https://www.herber.de/bbs/user/100961.xlsx
Ich möchte über die Schaltflächen eine der vier Varianten auswählen. Der Zellbereich in der ausgewählten Spalte sollte dann in die Spalte "Favorit" geschrieben/kopiert werden.
Wenn ich mich über die Bedienung der Schaltflächen für eine andere Variante entscheide, sollte sich auch der entsprechende Inhalt in der Spalte "Favorit" ändern.
Wichtig ist, dass im Makro ein Zellbereich variabel angegeben werden kann. Die Tabelle ist nicht als Tabelle formatiert.
Mit welchem Makro muss ich die einzelnen Schaltflächen belegen?
Für jeden Tipp bin ich sehr dankbar!
Beste Grüße
T1M0

Hi,
schreibe dieses Makro in ein allgemeines Modul und verknüpfe die OptionsButton jeweils mit dem Makro.

Sub Kopieren()
Dim lngLetzte As Long
Dim intSpalte As Integer
With ActiveSheet.Shapes(Application.Caller)
intSpalte = Range(.TopLeftCell.Address).Column
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, intSpalte)), _
Cells(Rows.Count, intSpalte).End(xlUp).Row, Rows.Count)
Range(Cells(3, intSpalte), Cells(lngLetzte, intSpalte)).Copy
Range("A3").PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
End Sub

---

Hallo!
Vielen Dank für die schnelle Hilfe!
Ich habe jedoch vergessen, ein wichtiges Kriterium mitzuteilen:
Wenn sich Einträge in der bevorzugten Variante ändern, soll sich das unmittelbar in der Favoritenspalte ändern. Das heißt ich benötige eine Art direkte Verknüpfung. Derzeit muss ich immer händisch den Schaltbutton bedienen damit die Änderung übernommen wird (die Favoritenspalte wird später für den Nutzer ausgeblendet und wird nur für weitere Berechnungen übertragen)
Das wird wohl die ganze Logik hinter dem Makro ändern. Sorry, hatte dieses Problem bei meiner ersten Anfrage nicht auf dem Schirm.
Kannst du/ihr mir weiterhelfen?
Danke und beste Grüße!
T1M0

Hi,
kopiere folgenden Code ins Codemodul des Tabellenblattes:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim optButton As OptionButton
Dim intSpalte As Integer
If Target.Row > 2 And Target.Column < 6 Then
If Target.Count = 1 Then
For Each optButton In ActiveSheet.OptionButtons
If optButton.Value = 1 Then Exit For
Next optButton
intSpalte = optButton.TopLeftCell.Column
If intSpalte = Target.Column Then
Application.EnableEvents = False
Cells(Target.Row, 1) = Target
Application.EnableEvents = True
End If
Else
MsgBox "Bitte nur 1 Zelle ändern"
End If
End If
End Sub

---

Klasse, vielen Dank!
Leider wird nun bei jedem Variantenwechsel die MsgBox "Bitte nur 1 Zelle ändern" angezeigt, da ja mehrere Einträge auf einmal kopiert werden. Besteht die Möglichkeit, dass die MsgBox nur dann erscheint, wenn man innerhalb der Spalte mehr als 1 Zelle kopiert?
Beste Grüße!

Hi,
ergänze diese Zeile:

    If Target.Row > 2 And Target.Column < 6 And Target.Column > 1 Then

---

Stark, jetzt ist es genauso wie ich es wollte!
Vielen herzlichen Dank!
Das Forum ist einfach nur der Hammer!
Beste Grüße!