Met macro onderste rij verwijderen

[zwinmi]

Hallo Forum!

Ik heb de volgende vraag. Met een macro wordt onderstaande vba-code uitgevoerd:

Sub KostenoverzichtSelectie()
Sheets("Kostenoverzicht").Range("7:7").Copy
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
Sheets("Kostenoverzicht").Range("11:11").Copy
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
Range("B2").ClearContents
Range("B3").Select
End Sub

Dus rij 7 wordt gekopieert, excel gaat van onderen naar boven tot het tekst ziet, gaat 1 regel omlaag, plakt de waarden, daarna weer van onder naar boven tot het tekst ziet en plak dan op die regel de opmaak. Daarna wordt regel 11 gekopieert en hetzelfde verhaal als met rij 7. Dan wordt B2 geselecteerd en gedelete en dan is cel B3 geselecteerd. Dit gaat goed.

Nu zou ik willen dat de code eerst de laatste rij opzoekt en deze verwijderd, daarna mag bovenstaande code pas uitgevoerd worden. Er moet dus nog een stukje voor. Ik denk zelf de volgende code: maar dan ipv waarden plakken, de hele rij verwijderen.

Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlValues

Ik ben benieuwd!

 

[HSV]

Lukt het hiermee Mike?

Sub KostenoverzichtSelectie()
[COLOR="Red"]Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).EntireRow.Delete[/COLOR]
Sheets("Kostenoverzicht").Range("7:7").Copy

 

[zwinmi]

Harry,

Hij werkt perfect, dank je! Ik kreeg het alleen voor elkaar dat ie kolom A steeds een regel verwijderde, maar die EntireRow had ik nodig, om de hele rij te verwijderen...

 

[zwinmi]

Hallo Harry, en andere forumleden,

Hij werkt toch niet zo goed als ik dacht . Ik heb maar even een voorbeeld in de bijlage geplakt. Zoals je hem bij openen ziet, werkt het wel als je op selectie drukt: onderste regel (met een somtotaal) wordt verwijderd, regel 7 gekopieerd en onderaan geplakt, daarna wordt regel 11 (eerst zichtbaar gemaakt) gekopieerd en onderaan geplakt (en weer onzichtbaar gemaakt). Regel 1 t/m 11 mogen nooit worden verwijderd met deze selectie-macro, Pas als regel 12 in gebruik is mag de laatste regel worden verwijderd, alvorens regel 7 en 11 onderaan geplakt worden. Test het bestandje maar dan zie je als je regel 12 t/m 20 op delete-macro klikt, de selectieknop niet meer goed werkt. Dus de knop werkt goed als bijvoorbeeld regel 12 t/m 15 al is ingevuld (laatste wordt verwijderd en regel 7+11 worden onderaan geplakt). Maar zodra je alles leeg maakt, dus rij 12 t/m bijvoorbeeld 20, gaat het fout zodra je op de selectieknop drukt. Als rij 12 leeg is mag er dus geen rij worden verwijderd en moet gewoon rij 7+11 op rij 12 en 13 geplakt worden.

Ik denk dat mij probleem nu wel duidelijk is :thumb: Ik ben benieuwd!

 

[HSV]

Zo lijkt het volgens mij wel te werken.

Sub KostenoverzichtSelectie()
[COLOR="Red"]Application.ScreenUpdating = False[/COLOR]
With Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp)
     If .Row > 11 Then .EntireRow.Delete
End With
[COLOR="red"]Rows("11:11").EntireRow.Hidden = False[/COLOR]
Sheets("Kostenoverzicht").Range("7:7").Copy
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Rows("11:11").EntireRow.Hidden = False
Sheets("Kostenoverzicht").Range("11:11").Copy
Sheets("Kostenoverzicht").Range("11:11").Copy
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Sheets("Kostenoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Rows("11:11").EntireRow.Hidden = True
Range("B2").ClearContents
Range("B3").Select
[COLOR="red"]Application.ScreenUpdating = True[/COLOR]
End Sub

Ik ben ook benieuwd.
Code ook iets ingekort, en kan misschien door de specialisten nog wel korter gemaakt worden.
Tevens het flikkeren van het beeld tegen gegaan.

Trouwens, hoe staat het met die andere open vraag van je Mike?

 

[Warme bakkertje]

Inkorten niet zozeer, beetje opkuisen

Sub KostenoverzichtSelectie()
With Application
    .ScreenUpdating = False
With Sheets("Kostenoverzicht")
    With .Range("A" & Rows.Count).End(xlUp)
        If .Row > 11 Then .EntireRow.Delete
    End With
    .Rows(11).EntireRow.Hidden = False
    .Rows(7).Copy
    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    .Range("A" & Rows.Count).End(xlUp).PasteSpecial xlFormats
    .Rows(11).Copy
    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    .Range("A" & Rows.Count).End(xlUp).PasteSpecial xlFormats
    .Rows(11).EntireRow.Hidden = True
    .[B2].ClearContents
    .[B3].Select
End With
    .ScreenUpdating = True
End With
End Sub

 

[zwinmi]

Heren, hartelijk bedankt!

Ook die screenupdating is een goede aanvulling, deze ga ik even op alle macro's zetten. @Harry mijn vorige vragen die ik heb gesteld zijn opgelost en staan als het goed is ook op opgelost.

Met vriendelijke groet,

Mike

 

[HSV]

Heren, hartelijk bedankt!

@Harry mijn vorige vragen die ik heb gesteld zijn opgelost en staan als het goed is ook op opgelost.

Met vriendelijke groet,

Mike

Deze onderstaande nog niet Mike.
http://www.helpmij.nl/forum/showthread.php?t=512948
En nog één die niet beantwoord is door jou.
Misschien over het hoofd gezien.

 

[zwinmi]

Harry,

Je had gelijk, ik heb even gezocht op m'n eigen vragen en de twee beantwoord en op 'opgelost' gezet.

 

[HSV]

Harry,

Je had gelijk, ik heb even gezocht op m'n eigen vragen en de twee beantwoord en op 'opgelost' gezet.

Mike, jij zet altijd je vragen netjes op opgelost, maar doordat er een vraag was die ik beantwoord had, dacht ik er ineens weer aan.
Niks aan de hand :thumb: