de juiste macro formule

[mark1050]

Ik ben bezig met het opstellen van een vragenlijst in Excel met behulp van verschillende dropdownmenu's. Daarbij wil ik de mensen die ik bevraag ook meerdere antwoorden kunnen laten geven per specifieke vraag en heb daarvoor bij elke betreffende vragen een button "voeg nog een extra antwoordregel toe" aangemaakt met daarachter een macro. Die macro kopieert de 1e antwoordregel en voegt die de regel daaronder weer toe en wist de waarde inhoud van de regel zodat de bevraagde persoon in deze nieuwe regel middels het dropdownmenu een nieuw antwoord kan kiezen.

Hoe kan ik de macro aanpassen zodat hij telkens de regel met het laatst ingevoerde antwoord kopieert ipv telkens de 1e? Loop namelijk ook tegen het probleem aan dat als je middels de macro bij de oranje antwoordregel een extra antwoordregel gaat toevoegen de macro achter de button voor de gele antwoordregel ook niet meer klopt. Wie weet raad want ik ben niet erg bekend met het programmeren van macro's in Excel.

 

[VenA]

Met een iets aangepast bestand (lijntjes en kleurtjes kan altijd nog) en een dubbelklik in kolom C

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 3 And Target <> "" And InStr(Target.CurrentRegion.Cells(1, 2), "(meerdere antwoorden mogelijk)") Then
    Target.EntireRow.Copy
    Cells(Target.Row + 1, 1).Insert Shift:=xlDown
    Cells(Target.Row + 1, 2).Resize(, 2).ClearContents
    Application.Goto Target.Offset(1)
    Cancel = True
  End If
End Sub

 

[mark1050]

beste VenA bedankt voor het aangepaste bestand. hier kan ik wel mee uit de voeten. Maar aangezien ik graag bijleer...waar heb je die code nu ergens ingebakken binnen Excel?

 

[VenA]

Bijleren is onderzoeken......

 

[HSV]

Of:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 3 And Target <> "" And InStr(Target.Offset(, -1), "(meerdere antwoorden mogelijk)") Then
    Rows(Target.Row + 1).Insert xlDown, xlAbove
    Application.Goto Target.Offset(1)
    Cancel = True
  End If
End Sub

 

[mark1050]

thanks..Ik ga er eens verder op studeren.