Stukje code automatisch doorkopieeren nummer tot een volgend nummer

[Antonisse1]

Zie bijgeleverd bestand.

In een kolom heb ik op bepaalde velden een nummer staan.

Na het draaien van code wil ik graag dat het nummer is door gekopieerd tot het volgende nummer.

Kan iemand voor mij de juiste code geven?

Alvast bedankt!

Vriendelijke groet,
David Antonisse

 

[daan108]

Moet het code zijn? 't Kan vrij makkelijk met een formule op het werkblad. Uit jouw voorbeeldfile, voorbeeld A: Plak deze formule in cel D4 naast kolom C en kopieer naar beneden zover als nodig:

=ALS(ISGETAL(C4);C4;D3)

Werking: Als er een waarde op de regel in kolom C staat dan neemt ie die waarde, en anders de waarde erboven in kolom D.

 

[Antonisse1]

Hartelijk dank voor de formule. Echter ik heb het kopieeren eigenlijk nodig in code, in die zin, de oorspronkelijke data laat ik middels code ordenen. De getallen kunnen op verschillende regels staan. Ik heb eigenlijk code nodig die de waarde uit de eerste cel kopieert tot zover er een cel komt met een nieuwe waarde, vanaf daar moet de nieuwe waarde worden gekopieerd. En dit dan tot weer een nieuwe waarde.

Hartelijk dank voor de ondersteuning of tips!

Groet,
David Antonisse

 

[daan108]

Probeer zoiets. Er zitten nog wat onvolkomenheden in (bijvoorbeeld als de laatste cel op regel maxRow een waarde bevat, dan zal het blokje erboven niet ingevuld worden), maar meestal zal het goed gaan.
Je moet zelf aangeven tot hoever er maximaal doorgevoerd mag worden (getal invullen in de code bij maxRow) en je moet in de code aangeven in welke kolom de data staan (ik ben uitgegaan van kolom A, je moet zelf invullen bij Set r0 = Range("A1").End(xlDown) welke)

Sub Doorkopieren()

Dim r0 As Range, rN As Range, rPlak As Range
Dim maxRow%


'Stel maximum aantal rijen in dat gevuld gaat worden (onderkant tabel)
maxRow = 35

'zoek vanaf cel A1, cel A1 mag niet een door te voeren waarde bevatten
'dat doorgekopieerd moet worden
'in principe is cel r0 de bovenste cel en rN de volgende cel met waarde erin.
'ertussenin wordt dus doorgekopieerd uit r0

Set r0 = Range("A1").End(xlDown)
Set rN = r0.End(xlDown)

Do While rN.Row < maxRow
    If IsEmpty(r0.Offset(1, 0)) Then
        If rN.Row <= maxRow Then
            'definieer bereik rPlak tussen r0 en rN
            Set rPlak = Range(r0.Offset(1, 0), rN.Offset(-1, 0))
            'rPlak.Select
            'kopieer de waarde uit r0 naar bereik rPlak
            rPlak.Value = r0.Value
        End If
    End If
    'bepaal de volgende cellen met waarde erin
    Set r0 = rN
    Set rN = r0.End(xlDown)
Loop

'Aanvullen tot onderkant tabel (tot en met regelnummer maxRow)
Set rN = r0.Offset(maxRow - r0.Row, 0)
Set rPlak = Range(r0.Offset(1, 0), rN.Offset(0, 0))
rPlak.Value = r0.Value


End Sub