Bertjens48
Gebruiker
- Lid geworden
- 22 okt 2018
- Berichten
- 9
Hallo allen,
In het excel bestand wat gebruikt wordt voor de voorraad worden ook de geplaatste bestellingen bijgehouden. Er worden twee bladen voor gebruikt, een met nieuwe bestellingen "bestellijst" (blad2) en "Bestel history"(blad7). Als de geplande binnenkomst datum is verstreken wordt deze rij in kolom A voorzien van de term "oud", en moet deze verplaatst worden naar "bestel history". Het is van belang dat de volgorde waarin de producten staan behouden blijft in het nieuwe blad.
Er wordt nu gebruik gemaakt van onderstaande code. Deze werkt voor een groot gedeelte, maar nog niet 100%.
Zo lijkt het er op dat de loop cellen overslaat, Elke keer als een rij wordt verplaatst slaat hij de volgende cel over.
Daarnaast is de code ook vrij traag, is dit nog op te lossen.
Zouden jullie mij kunnen helpen met bovenstaande code?
Alvast bedankt.
In het excel bestand wat gebruikt wordt voor de voorraad worden ook de geplaatste bestellingen bijgehouden. Er worden twee bladen voor gebruikt, een met nieuwe bestellingen "bestellijst" (blad2) en "Bestel history"(blad7). Als de geplande binnenkomst datum is verstreken wordt deze rij in kolom A voorzien van de term "oud", en moet deze verplaatst worden naar "bestel history". Het is van belang dat de volgorde waarin de producten staan behouden blijft in het nieuwe blad.
Er wordt nu gebruik gemaakt van onderstaande code. Deze werkt voor een groot gedeelte, maar nog niet 100%.
Zo lijkt het er op dat de loop cellen overslaat, Elke keer als een rij wordt verplaatst slaat hij de volgende cel over.
Daarnaast is de code ook vrij traag, is dit nog op te lossen.
Code:
Private Sub CommandButton1_Click()
Dim rij As Long
Dim n As Long
Dim src As Worksheet
Dim trg As Worksheet
Set src = Blad2
Set trg = Blad7
rij = trg.[A65536].End(xlUp).Row + 1
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
For n = 6 To Blad2.[A65536].End(xlUp).Row
If Cells(n, "A").Value = "" Then Exit For
If Cells(n, "A").Value = "Oud" Then
Range(Cells(n, "B"), Cells(n, "Q")).Copy 'Kopieer kolom B t/m Q
trg.Cells(rij, "A").PasteSpecial xlPasteValues
Range(Cells(n, "A"), Cells(n, "Q")).EntireRow.Delete
rij = rij + 1
End If
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Zouden jullie mij kunnen helpen met bovenstaande code?
Alvast bedankt.