rijen invoegen

[Jelle2010]

Beste experts,

Ik krijg het volgende niet voor elkaar helaas. Ik heb een werkblad(bron) en daarin staan declaraties in de kolommen C, D en E. Ik wil deze rijen kopieren naar blad 2(resultaat) alleen wanneer er in zowel kolom C, D en E gegevens staan dat dan de regel 3 keer wordt gekopieerd naar blad 2 en dat in iedere regel een ander bedrag wordt getoond. Dus dat alle bedragen onder elkaar komen te staan(in kolom E) in het tabblad resultaat. Dan dient in kolom C de code van de declaratie komen te staan.

Ik heb het e.e.a. uitgewerkt in Excel wat het resultaat zou moeten zijn. Met kleuren heb ik het aan gegeven wat bij elkaar hoort. Kleuren hoeven niet in de macro meegenomen te worden.

Ik hoop dat jullie mij kunnen helpen.

Alvast vriendelijk bedankt.

Groeten,

Jelle

 

[snb]

Je bent vergeten de code die je zelf al gemaakt hebt toe te voegen.

 

[Jelle2010]

Beste snb.

Deze ben ik niet vergeten aangezien ik er echt niet uitkom Om het even wat duidelijker te maken heb ik het resultaat ook even in een Excel bestand gezet, omdat ik het wat moeilijk uit te leggen vind.
Dus in het werkblad "bron" heb ik gegevens staan en deze wil ik naar het werkblad "resultaat" krijgen op de manier hoe ze daar staan gepresenteerd. Nu heb ik het handmatig gedaan. Maar je begrijpt dat wanneer er meer gegevens in "bron" staan dan 5 regels dan zou ik dat graag niet meer handmatig willen doen.
Zou jij mij hier mee kunnen helpen?

Alvast vriendelijk bedankt!

Groeten,

Jelle

Je bent vergeten de code die je zelf al gemaakt hebt toe te voegen.

 

[Jelle2010]

Zou iemand mij hier nog mee kunnen helpen of is dit niet mogelijk met VBA?
Alvast super bedankt!

 

[Jelle2010]

Oplossing

Probleem is opgelost.

Sub test()

wsSource = "Bron"
wsTarget = "Resultaat"

sourceStartRow = 2
currentTargetRow = 1

For currentSourceRow = sourceStartRow To Sheets(wsSource).Range("A65536").End(xlUp).Row

    If Sheets(wsSource).Range("C" & currentSourceRow).Value <> "" Then

        Sheets(wsTarget).Range("A" & currentTargetRow).Value = Sheets(wsSource).Range("A" & currentSourceRow).Value
        Sheets(wsTarget).Range("B" & currentTargetRow).Value = Sheets(wsSource).Range("B" & currentSourceRow).Value
        Sheets(wsTarget).Range("C" & currentTargetRow).Value = "Declaratie 1"
        Sheets(wsTarget).Range("D" & currentTargetRow).Value = Sheets(wsSource).Range("C" & currentSourceRow).Value

        currentTargetRow = currentTargetRow + 1
        
    End If

    If Sheets(wsSource).Range("D" & currentSourceRow).Value <> "" Then

        Sheets(wsTarget).Range("A" & currentTargetRow).Value = Sheets(wsSource).Range("A" & currentSourceRow).Value
        Sheets(wsTarget).Range("B" & currentTargetRow).Value = Sheets(wsSource).Range("B" & currentSourceRow).Value
        Sheets(wsTarget).Range("C" & currentTargetRow).Value = "Declaratie 2"
        Sheets(wsTarget).Range("D" & currentTargetRow).Value = Sheets(wsSource).Range("D" & currentSourceRow).Value

        currentTargetRow = currentTargetRow + 1
        
    End If

    If Sheets(wsSource).Range("E" & currentSourceRow).Value <> "" Then

        Sheets(wsTarget).Range("A" & currentTargetRow).Value = Sheets(wsSource).Range("A" & currentSourceRow).Value
        Sheets(wsTarget).Range("B" & currentTargetRow).Value = Sheets(wsSource).Range("B" & currentSourceRow).Value
        Sheets(wsTarget).Range("C" & currentTargetRow).Value = "Declaratie 3"
        Sheets(wsTarget).Range("D" & currentTargetRow).Value = Sheets(wsSource).Range("E" & currentSourceRow).Value

        currentTargetRow = currentTargetRow + 1
    
    End If

Next currentSourceRow

End Sub