Regel kopieren en als waarde plakken

[mjdejoode]

Goededag,

Ik heb een vraag. ik heb onderstaande code. De code was om lege rijen te verwijderen en die heb ik aangepast om een waarde in een kolom te zoeken en dan de hele rij te kopieren en te plakken als waarde. Alleen doet hij dit alleen bij de eerste regel die hij tegenkomt. Hoe los ik dit op?

Sub regels_vastzetten()

    
    Range("datum2").Select
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
For i = 1 To Rng
If ActiveCell.Value = 1 Then
Selection.EntireRow.Copy
Selection.EntireRow.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
ActiveCell.Offset(1, 0).Select

End If

Next i

End Sub

 

[tilpi]

Probeer het zo eens

Sub regels_vastzetten()
Range("datum2").Select
Rng = Selection.Rows.Count
For i = 1 To Rng
If ActiveCell.Value = 1 Then
Selection.EntireRow.Copy
Selection.EntireRow.PasteSpecial Paste:=xlValues
End If
ActiveCell.Offset(1, 0).Select
Next i
Application.CutCopyMode = False
End Sub

Mvg

Piet

 

[mjdejoode]

Helaas hij werkt dan nog steeds niet. Hij pakt nog steeds alleen de eerste regel.

 

[Finch]

Waarom gebruik je een for ... next lus wanneer je die eigenlijk niet gebruikt in het stuk tussen for en next (maw daar wordt nergens een i als variabele in gebruikt).

Zeg ook eens duidelijk wat de opzet is. Je selecteert nu eerst een range, telt hoeveelt rijen die range heeft, en dan ... wat is dan juist de bedoeling?

 

[mjdejoode]

Hey finch,

In het bestand waar deze macro in komt staan circa 2000 regels die allen gekoppeld zijn aan externe documenten. Ik wil dat als er in een bepaalde kolom een waarde is geplaats (bijvoorbeeld "afgehandel") dat de hele rij dan wordt gekopieert en op dezelfde lokatie wordt geplakt als waarde en niet meer als formule. Dit omdat de externe bestanden verplaats/gearchiveerd worden als een project is afgehandeld, maar in het totaalblad moet het nog wel blijven staan voor het jaar/2 jaar overzicht.
Waarom die for-next lus erin zit? Dat weet ik eigenlijk ook niet. Ik heb de basis voor deze code van dit forum af gehaald en veranderd zoals hij volgens mij hoorde te zijn. De code werkte wel om de lege rijen te verwijderen, maar voor wat ik wil doet hij alleen bij de eerste rij die hij tegenkomt.

 

[mjdejoode]

De for...next lus is toch om ook de volgende regel te controleren en aan te passen?

 

[Finch]

Klopt, en binnen uw for next lus hier heb je een variable, nl i in dit geval.
Normaal gezien maakt ge hiervan gebruik binnen uw code iets in de vorm van

cells(i,1)="blabla"

Maar jij maakt helemaal geen gebruik van een i, wat er voor zorgt dat uw for next loop niet doet wat je bedoelde, en eigenlijk overbodig is.

 

[mjdejoode]

hm...
Dus die hele for...next loop is onzin in mijn code?
Maar hoe zorg ik er dan voor dat hij die hele kolom controleert of daar de waarde "1"in staat en als het erin staat dat hij dan de hele rij kopieërt en plakt als waarde?

Hieronder heb ik de code uitgesplits zoals ik denk wat hij doet. Als ik denk dat hij iets doet als dat niet zo is zou ik het graag willen weten

Sub regels_vastzetten()
Range("datum2").Select 'zorgt ervoor dat de de kolom datum 2 wordt geselecteerd'
Rng = Selection.Rows.Count 'telt het aantal rijen die in kolom datum2 staan en geeft dat op als rng/bereik'
For i = 1 To Rng 'zorgt ervoor dat elke keer een rij lager wordt vergeleken'
If ActiveCell.Value = 1 Then 'controleerd of de waarde van de hierboven op gegeven rij in de kolom datum2 de waarde 1 bevat'
Selection.EntireRow.Copy 'kopieërt de hele rij'
    Selection.EntireRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'plakt de hele rij als waarde'
End If
ActiveCell.Offset(1, 0).Select 'zorgt ervoor dat een cel lager wordt geselecteerd'
Next i 'stuurt weer terug naar het begin van de loop'

End Sub

Ik heb het ook geprobeerd met een for each...next loop geprobeerd, maar dan werkt het ook niet. Dan krijg ik een fout bij de 4de regel.

Sub regels_vastzetten2()
Range("datum2").Select
Rng = Selection.Rows.Count
For Each Row In Rng
If ActiveCell.Value = 1 Then
Selection.EntireRow.Copy
    Selection.EntireRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If

Next

End Sub

Of moet ik het helemaal niet in de "loops" zoeken?

 

[Finch]

Ik heb hieronder wat code geschreven en voorzien van commentaar die hetgeen zou moeten doen wat jij vraagt. Ik hoop dat je alles begrijpt, anders vraag gerust.

[FONT="Courier New"]Sub regels_vastzetten()

Dim rngCel As Range 'definieert een variabele nl. rngCel als een  range

Application.ScreenUpdating = False 'verhindert het voordurend updaten van het scherm

For Each rngCel In Range("datum2") 'aangezien het benoemde bereik "datum2" maar één kolom beslaat, gaan we elke cel van dat bereik af (= elke rij aangezien we met 1 kolom te maken hebben) met de for each constructie
    With rngCel 'om telkens een herhaling van rngcel te voorkomen gebruiken we with (icm end with)
    If .Value = 1 Then 'test om te zien of de waarde gelijk is aan 1
        .EntireRow.Copy 'de hele rij copieren
        .EntireRow.PasteSpecial Paste:=xlValues 'de hele rij plakken als waarden
    End If 'if then clausule afsluiten
    End With 'einde with aangeven
Next rngCel 'de volgende cel (lees:rij) selecteren

Application.CutCopyMode = False 'het clipboard leegmaken en de visuele restanten (stippellijnen) van de copy paste verwijderen
Range("datum2").Cells(1, 1).Select 'de eerste cel van ons bereik "datum2" terug selecteren
Application.ScreenUpdating = True 'het updaten van het scherm terug aanzetten
End Sub
[/FONT]

BTW, de uitleg bij jouw lijnen code die je gaf is niet helemaal correct.

Edit: Je zou ook kunnen werken door gebruik te maken van autofilters. Op die manier kan je loops uitschakelen, en is de code efficienter, maar het correct gebruik hangt af van hoe u data gestructureerd is binnen je Excel bestand.

 

[mjdejoode]

Hey Finch,

Na wat puzzelen is het gelukt.
Ik zat op ongeveer dezelfde code als jij net had gegeven en toen zag ik jou post
En het werkte

Dank u wel:thumb::thumb: