Rij verplaatsen en verwijderen

[Bramco]

Hallo,

Al enkele dagen schuim ik het internet af om een juiste vba code te vinden.
De opzet is de volgende. In kolom 9 komt "Mag weg" te staan indien het product voor een bepaalde klant is afgewerkt.
De gehele rij met product- en klantgegevens moet dan naar blad 2 in een "geschiedenis"-lijst komen en in de "up-to-date"-lijst verdwijnen.

Mijn code is de volgende:

Sub VerplaatsenRij()

Dim i As Integer
Dim y As Integer
Application.ScreenUpdating = False

i = ActiveSheet.UsedRange.Rows.Count
For y = i To 1 Step -1
If Cells(y, 9).Value = "Mag weg" Then
Cells(y, 9).EntireRow.Cut Worksheets(2).Cells(i, 1)
Cells(y, 1).EntireRow.Delete
i = i + 1
End If
Next

End Sub

Deze werkt zonder problemen maar brengt andere problemen met zich mee. Stel mijn range is 40 en er mogen vandaag 3 rijen weggeschreven worden komen deze op rij 40,39 en 38 te staan (dit is al vervelend dat dit niet 1,2,3 is). Maar wanneer er morgen 5 rijen aan toegevoegd worden en er weer 4 mogen weggeschreven worden, worden voorgaande rijen overschreven (terwijl ik ze eigenlijk om 4,5 en 6 wil)

Het uiteindelijke resultaat zou een lijst moeten zijn die elke dag bijgewerkt kan worden zodat de productie een duidelijk overzicht heeft van het werk met daarnaast (op blad 2) een lijst met alle afgewerkte producten van de voorbije jaar.

Hopelijk kan iemand me hier verder helpen! Moesten er nog vragen zijn, stel gerust
Alvast bedankt,
Bramco

 

[OctaFish]

Allereerst natuurlijk welkom bij HelpMij . Twee opmerkingen: code maak je op met de CODE knop (als je via Geavanceerd werkt zie je die) en we hebben graag een voorbeeldbestandje, dat werkt een stuk sneller.

 

[Bramco]

Hey OctaFish,
Bedankt voor de snelle reactie. Aangezien het over klanteninfo gaat kon ik mijn oorspronkelijk excelbestand hier niet zetten. Bij deze heb ik het een beetje aangepast Daardoor staat de "Mag weg" nu wel in kolom 7 ipv 9!
Ook de info dat een product is afgewerkt komt uit een andere excellijst dus heb ik dit aangepast naar: "Mag weg" wordt gegeven indien de huidige datum een week na de einddatum is. Bij deze: Bekijk bijlage Excel Macro's site.xlsm

Sub VerplaatsenRij()

Dim i As Integer
Dim y As Integer
Application.ScreenUpdating = False

i = ActiveSheet.UsedRange.Rows.Count
For y = i To 1 Step -1
If Cells(y, 9).Value = "Mag weg" Then
Cells(y, 9).EntireRow.Cut Worksheets(2).Cells(i, 1)
Cells(y, 1).EntireRow.Delete
i = i + 1
End If
Next

End Sub

Hopelijk is het zo in orde!

 

[VenA]

Probeer deze eens

Sub VenA()
With Sheets(1).Cells(1).CurrentRegion
 .AutoFilter 7, "Mag weg"
 .Offset(1).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
 .Offset(1).EntireRow.Delete
 .AutoFilter
End With
End Sub

 

[Bramco]

Jep deze lijkt me inderdaad goed te werken! Ik heb gisterennamiddag zelf nog wat zitten zoeken en uitpuzzelen en kwam uiteindelijk bij dit wat ook wel lijkt te kloppen.

Sub MoveDelete()
    Dim i As Integer, y As Integer, j as Integer
    Application.ScreenUpdating = False

    'Find first free row in sheet2
    j = Worksheets(2).cells(Rows.Count, 9).End(xlUp).Row + 1
    i = ActiveSheet.cells(Rows.Count, 9).End(xlUp).Row

    For y = i To 1 Step -1
        If Cells(y, 9).Value = "Mag weg" Then
            Rows(y).Copy Worksheets(2).Rows(j)
            Rows(y).EntireRow.Delete
            j = j + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Bedankt voor alle hulp!

 

[VenA]

Altijd goed om zelf wat te maken wat ook werkt:thumb:

Als het om veel rijen gaat is de filter methode sneller. Maar wat werkt, dat werkt.