Cel kopiëren op voorwaarde van celkleur.

[Andre175]

Ik ben bezig met het maken van een spreadsheet voor het plannen van 60 activiteiten die georganiseerd worden voor ruim 300 kinderen van de basisscholen bij ons in de buurt.
Ik ben al een aardig eind op weg, loop echter vast.
Ik vraag mij af of er een mogelijkheid in Excel is om in een formule een cel automatisch te kopiëren afhankelijk van de kleur.

"Als cel is groen dan copy anders doe niets"

heb een klein bestandje gemaakt wat ongeveer overeen komt met het originele bestand, echetre met veeeel minder gegevens. In het bijgevoegde bestand alleen datgene erin gezet wat van belang is voor mijn probleem.

wie o wie weet een oplossing.


André

 

[HSV]

Test het maar eens.

Sub hsv()
Dim i As Long, j As Long
 With Sheets("opgave kinderen").ListObjects(1)
   For i = 1 To .ListRows.Count
    For j = 3 To .ListColumns.Count
     If .DataBodyRange(i, j).Interior.ColorIndex = 14 Then Sheets("indeling kinderen").ListObjects(1).DataBodyRange(i, j) = .DataBodyRange(i, j).Value
    Next j
   Next i
 End With
End Sub

 

[Andre175]

Bedankt Harry.

ik ga het proberen, moet er wel bij zeggen dat VBA voor mij een nieuwe uitdaging is.... hoop dat het lukt


André

 

[Andre175]

Krijg het nog niet werkend, kan iemand het bestand wat ik heb geupload aanpassen met de juiste VBA?
misschien dat ik dan verder kom.

bvd André

 

[VenA]

Met een iets andere code dan van @HSV. Je kan de tabel in 'Opgave Kinderen' nu ook aanvullen met nieuwe kinderen. Als je op de tab 'Indeling kinderen' klikt krijg je een kopie van de tabel met alleen de waarden van de groene cellen.

Private Sub Worksheet_Activate()
Dim j As Long, jj As Long, ar
  With Sheets("Opgave Kinderen").ListObjects(1)
    ar = .DataBodyRange
    For j = 1 To .ListRows.Count
      For jj = 3 To .ListColumns.Count
       ar(j, jj) = IIf(.DataBodyRange(j, jj).Interior.ColorIndex = 14, .DataBodyRange(j, jj).Value, "")
      Next jj
    Next j
  End With
  Sheets("Indeling Kinderen").ListObjects(1).DataBodyRange = ar
End Sub

 

[HSV]

ar(j, jj) = IIf(.DataBodyRange(j, jj).Interior.ColorIndex = 14, ar(j, jj), "")

Of:

 If .DataBodyRange(j, jj).Interior.ColorIndex <> 14 Then ar(j, jj) = ""

en:

ListObjects(1).DataBodyRange = ar

 

[Andre175]

Helemaal Top....
heb het werkend zoals ik het in gedachten had.

Bedankt voor de reacties.

André