Variabel selecteren

[Oude leerling]

Geacht forum,

In een kolom staan bovenaan een aantal nullen en daaronder de bedragen.
Nu varieert het aantal nullen bovenaan en wil ik alleen de bedragen welke daaronder staan kopiëren en plakken.
Dit probleem gaat boven mijn pet , ik kom daar niet uit.
Kunt u mij helpen?

Bekijk bijlage Variabel selecteren.xlsm , zie de bijlage

 

[edmoor]

En moet die 25 in K4 dan naar B4 of naar B2?

 

[Oude leerling]

Nee dat hele rijtje onder die nullen moet naar B3 , 25 dus in B3
Het heeft te maken met de eerste week van het jaar
de eerste omzetten van het nieuwe jaar start met 2 Jan.

 

[edmoor]

Dat wil je dus automatisch laten plaatsvinden. Door welke actie moet dan dat kopiëren worden gestart?

 

[Oude leerling]

Het is een deel van een grotere macro welke nog meer doet.
ik hak zo'n macro altijd in stukjes en als het dan werkt pas ik het in in het totaal.
Dus een aparte macro starten via uitvoeren

 

[edmoor]

Je kan dan op het relevante punt in je macro de volgende sub aanroepen:

Sub CopyK2B()
    Dim B As Long
    Dim K As Long
    Dim KL As Long
    
    With ActiveSheet
        KL = .Cells(.Rows.Count, "K").End(xlUp).Row
        For K = 1 To KL
            If .Cells(K, 11).Value > 0 Then
                Exit For
            End If
        Next K
    End With
    
    If K > 0 Then
        For B = 3 To KL
            Cells(B, 2) = Cells(K, 11)
            K = K + 1
        Next B
    End If
End Sub

 

[Oude leerling]

Fantastisch , wat zit er een kennis bij jou.
Ik ga er eens op studeren om te kijken of ik het snap.
Hartelijk bedankt.
Vriendelijke groet , J.M.Zonneveld

 

[edmoor]

Ok. Ik heb hem een beetje voor je gedocumenteerd:

Sub CopyK2B()
    Dim B As Long                                   [COLOR="#008000"]'Regelnummer voor kolom B (2)[/COLOR]
    Dim K As Long                                   [COLOR="#008000"]'Regelnummer voor kolom K (11)[/COLOR]
    Dim KL As Long                                  [COLOR="#008000"]'Laatst gebruikte regel in kolom K[/COLOR]
    
    With ActiveSheet                                [COLOR="#008000"]'Op het actieve werkblad[/COLOR]
        KL = .Cells(.Rows.Count, "K").End(xlUp).Row [COLOR="#008000"]'Bepaal de laatst gebruikte regel in kolom K[/COLOR]
        For K = 1 To KL                             [COLOR="#008000"]'Loop van regel 1 tot die laatst gebruikte regel[/COLOR]
            If .Cells(K, 11).Value > 0 Then         [COLOR="#008000"]'Als de waarde van de cel in die regel groter is dan 0[/COLOR]
                Exit For                            [COLOR="#008000"]'Verlaat dan de loop. K bevat nu het juiste regelnummer[/COLOR]
            End If
        Next K
    End With

    If K > 0 Then                       [COLOR="#008000"]'Als dat nummer groter is dan 0[/COLOR]
        For B = 3 To KL                 [COLOR="#008000"]'loop vanaf regelnummer 3 in kolom B tot het regelnummer in KL[/COLOR]
            Cells(B, 2) = Cells(K, 11)  [COLOR="#008000"]'Plaats de waarde van de cel in de onderhanden regel in de juiste cel van kolom B[/COLOR]
            K = K + 1                   [COLOR="#008000"]'Ophogen onderhanden regel met 1[/COLOR]
        Next B
    End If
End Sub

 

[Oude leerling]

Iets te vroeg op opgelost gezet.

Als er geen nullen staan moet er aansluitend geplakt worden in kolom B.
Dat doet hij niet.
Het word weer in B3 geplaatst

 

[edmoor]

Logisch. Je zei dat er moet worden begonnen op 2 januari en die staat in B3.

 

[Oude leerling]

Wat onduidelijk gezegd.
Als er eenmaal data naar kolom B is verplaatst , week1, dan moet de volgende data , week2 aansluitend daaronder gezet worden .

Nog bedankt voor de uitleg hartstikke fijn , zo leer ik er wat van

 

[edmoor]

Ok. Dan moet je dus kijken of B3 al gevuld is en zoja, de laatste regel van kolom B bepalen om daar de volgende keer in te beginnen. Zou moeten lukken na die uitleg

 

[Oude leerling]

Ik ga het proberen