Besturingselementen kopiëren in Excel

[FrankBaart]

Hallo, Ik heb een werkblad waarbij ik door middel van een macro een stuk tekst en een keuze vak wil kopiëren naar de "Active.Cell". Mijn probleem is dat de cel waaraan het keuzevak is gekoppeld niet mee wijzigt.

In het bijgaande voorbeeld kan ik het misschien duidelijk maken. Als de active cell A36 is, en ik voer de macro uit met ctrl-A, dan zou het keuzevak gekoppeld moten worden met cel Q43, maar deze blijft helaas op Q8 staan. Als ik de macro meerdere keren uitvoer, een keer van A36, een keer van A50 en een keer op A64, zijn alle keuzevakken gekoppeld aan Q8 en dan werken de zoekfuncties onder het keuzevak niet meer omdat ze op de verkeerde cel zoeken.

Overigens heb ik bij het opnemen van de macro de "relatieve verwijzingen gebruiken" aan staan.

Is hier iets op te vinden ?

Waar het uiteindelijk om gaat is dat de waarden op N44 t/m N48 (nadat de macro is uitgevoerd) afhankelijk zijn van de gekozen vloerklasse overeenkomstig NEN-EN-1991-1-1.

Als er een andere, eenvoudigere manier is ben ik ook geholpen.

Kan iemand mij helpen? Alvast bedankt!

Bekijk bijlage Map2.xls

 

[HSV]

Run de code hsv(), en de gegevens worden onderaan de lijst gekopiëerd incl. de vervolgkeuzelijst.
Daaraan wordt op basis van de lengte van Kolom Q de 'linkedcell' gezet, maar dan 14 rijen lager.

Sub hsv()
 Sheets("Blad2").Range("A1:O13").Copy Sheets("Blad1").Cells(Rows.Count, 3).End(xlUp).Offset(2, -2)
   y = 0
    For Each sh In Sheets("Blad1").Shapes
      y = y + 1
    Next
 With Sheets(1)
   .Shapes(y).Name = "Vervolgkeuzelijst_" & y
   .Shapes("Vervolgkeuzelijst_" & y).ControlFormat.LinkedCell = Cells(Rows.Count, 17).End(xlUp).Offset(14).Address
 End With
End Sub

 

[FrankBaart]

thnx,

ik ga het dit weekend proberen.

Ik zal je laten weten hoe het gaat.

Frank

 

[FrankBaart]

Beste Harry,

Hartstikke goed. Alleen wordt de tekst inclusief de koppeling naar de "linked Cell" nu onder de laatst gebruikte cel gezet via "End(xlUp)". In mijn uiteindelijke spreadsheet komt er nogal wat tekst onder deze tabellen te staan. Dat betekend dat de gekopieerde delen ook helemaal onderaan komen te staan. Ik ben aan het stoeien geweest met het wijzigen van "End(xlUp)" naar "ActiveCell", maar het lukt me niet.

Wat is de juiste code om de tekst van Blad2!(A1:O13) tussen te voegen in plaats van onderaan te plaatsen ?

Alvast bedankt.

Frank

 

[HSV]

Als het voorbeeldbestand afwijkt van het origineel Frank, kan ik niet zien natuurlijk.
Dus..........

 

[FrankBaart]

Helemaal waar.....

In mijn eigen macro had ik wat regels opgenomen om rijen tussen te voegen, maar dit was niet duidelijk vermeld. Hierbij het aangepaste voorbeeld.

Ik wil dus graag vloeren tussen voegen op cel A36. Als er nog een vloer bij moet komt deze op cel A50, vervolgens op cel A64 etc. Dat betekent dus dat er telkens 14 regels moeten worden ingevoegd waar de tekst met een keuzevak in worden gekopieerd.

Frank

Bekijk bijlage Map2a.xls

 

[HSV]

Houd er rekening mee dat je in groepen van 13 denkt, met een lege cel eronder (dus 14 eigenlijk).
Test het eens.

Sub hsv()
With Sheets("Blad1")
 .Range("U1") = WorksheetFunction.CountIf(.Columns(1), "Verdiepingsvloer")
   HS = IIf(.Range("A36") Like "Verdiepingsvloer*", WorksheetFunction.CountIf(.Columns(1), "Verdiepingsvloer*") * 14 + 37, .Range("A37").Row)
    .Cells(HS, 1).Resize(14).EntireRow.Insert
      Sheets("Blad2").Range("A1:O13").Copy .Cells(HS, 1)
    For Each sh In .Shapes
      sh.Name = "Vervolgkeuzelijst_" & sh.TopLeftCell.Row
      sh.ControlFormat.LinkedCell = .Cells(sh.TopLeftCell.Row, 17).Address
   Next
 End With
End Sub