Gegevens verdelen over verschillende pagina's met één opdrachtknop

[sororitas]

Goedeavond,

Ik zit momenteel met het volgende vraagstukje:

Stel: ik heb een excel-bestandje bestaande uit drie pagina's
pagina 1: invoer+uitkomst
pagina 2: werkblad
pagina 3: blabla

Op pagina 1 voer ik gegevens in:

Kolom5 Kolom6

VakA datum uitslag
VakB 22/04/07 Positief
VakC 22/04/07 negatief

Pagina 2 is een pagina waar (in dit geval het positieve) moet worden bijgeplaats, pagina drie negatief.

Volgende formule heb ik al:

Private Sub CommandButton1_Click()

Sub Macro1()

   Dim r As Range
    
    For Each r In Sheets("invoer+uitkomst").Range("B5")
        If Len(r.Value) > 0 Then
            With r.Resize(1, 5)
                .Copy
                Sheets("werkblad").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                .ClearContents
            End With
        End If
    Next
    

    
    For Each r In Sheets("invoer+uitkomst").Range("C5")
        If Len(r.Value) > 0 Then
            With r.Resize(1, 5)
                .Copy
                Sheets("blabla").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                .ClearContents
            End With
        End If
    Next

    
    
    
End Sub

Probleempje: het programma voert het laatste gedeelte niet uit (en zal dus alleen range B5 naar werkblad transporteren. Range C5 laat hij staan en het blad "blabla"bllijft dus leeg.

Is er iemand die mij hiermee verder kan helpen?

Alvast bedankt,

MVG

Sororitas

 

[sororitas]

oei, weinig reactie precies.

Als er zaken niet duidelijk zijn vraag gerust hoor!

 

[Finch]

Heb je een voorbeeldbestand?

Waarom een for each loop gebruiken wanneer je range maar uit 1 cel bestaat.

 

[sororitas]

Als het goed is zou er nu een gecomprimeerd mapje moeten bijzitten

Ficnh, de loop die ik gebruik is gebaseerd op een formule die ik hier ooit eens heb gekregen om een range van meer cellen te verplaatsten naar een ander blad.

Toen ik een range van maar één cel nodig had bleef dit eigenlijk gewoon werken. Vandaar dat die loop nooit is aangepast

Logischerwijs dacht ik dat de loop kon herhaald worden telkens voor een andere range, mar blijkbaar doet hij dit niet.

Groetjes

 

[Finch]

Je code in dit geval werkend krijgen is geen enkel probleem. Je code kan echter ook een stuk eenvoudiger. Voor deze opdracht heb ik echter geen tijd, maar zolang de code doet wat je vraagt neem ik aan dat dat voor jou minder belangrijk is.

Voor de oplossing copieer ik even de (relevante) code die je momenteel gebruikt:

For Each r In Sheets("invoer+uitkomst").Range("C5")
        If Len(r.Value) > 0 Then
            With r.Resize(1, 5)
                .Copy
                Sheets("blabla").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                .ClearContents
            End With
        End If
    Next

In je voorbeeldbestand geef je aan dat je rij 6 wil kopieren, maar in je code refereer je naar rij 5 (dmv C5), dat verklaart waarom het niet lukt. C5 is leeg na het copieren van rij 5. Die wijziging vervangen geeft volgende code en deze werkt wel:

For Each r In Sheets("invoer+uitkomst").Range("[COLOR="Red"]B6[/COLOR]")
        If Len(r.Value) > 0 Then
            With r.Resize(1, 5)
                .Copy
                Sheets("blabla").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                .ClearContents
            End With
        End If
    Next

 

[sororitas]

En hij heeft gelijk

Bedankt voor de moeite Finch.
Een kortere code heeft voor mij inderdaad niet zoveel belang, met deze kleine aanpassing echter kan ik weer een tijdje voort!! :thumb: