Beste mensen,
Ik ben bezig met het combineren van een voorraad lijst en verkocht lijst.
Nou wil ik dus dat als ik bij een product in de voorraad lijst b.v. auto 1, dat ik aanvink ''verkocht'' dat hij deze verplaatst naar een lijst waar verkochte dingen instaan.
Nou is het me wel gelukt om hem te verplaatsten naar een ander werkblad d.m.v. onderstaande code welke ik van dit forum heb gehaald.
Sub Afgerond()
Application.ScreenUpdating = False
Dim c As Range
Dim rw As Long
For Each c In [Q5:Q100]
If c = "Ja" Then
c.Rows.EntireRow.Copy
['Blad 4'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
End If
Next
For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(rw, "Q") = "Ja" Then Rows(rw).Delete
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Sub Niet_Afgerond()
Application.ScreenUpdating = False
Dim c As Range
Dim rw As Long
For Each c In [Q5:Q100]
If c = "Nee" Then
c.Rows.EntireRow.Copy
['Blad 3'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
End If
Next
For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(rw, "Q") = "Nee" Then Rows(rw).Delete
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Dit werk perfect, alleen nu het liefst nog naar een andere werkmap toe waar ik de overzichten in bij hou.
Hoe kan ik dit het beste oplossen?
We werken trouwens met een server waar alles op staat.
Groet Kevin
Ik ben bezig met het combineren van een voorraad lijst en verkocht lijst.
Nou wil ik dus dat als ik bij een product in de voorraad lijst b.v. auto 1, dat ik aanvink ''verkocht'' dat hij deze verplaatst naar een lijst waar verkochte dingen instaan.
Nou is het me wel gelukt om hem te verplaatsten naar een ander werkblad d.m.v. onderstaande code welke ik van dit forum heb gehaald.
Sub Afgerond()
Application.ScreenUpdating = False
Dim c As Range
Dim rw As Long
For Each c In [Q5:Q100]
If c = "Ja" Then
c.Rows.EntireRow.Copy
['Blad 4'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
End If
Next
For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(rw, "Q") = "Ja" Then Rows(rw).Delete
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Sub Niet_Afgerond()
Application.ScreenUpdating = False
Dim c As Range
Dim rw As Long
For Each c In [Q5:Q100]
If c = "Nee" Then
c.Rows.EntireRow.Copy
['Blad 3'!A65536].End(xlUp).Offset(1, 0).Insert Shift:=xlDown
End If
Next
For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(rw, "Q") = "Nee" Then Rows(rw).Delete
Next
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Dit werk perfect, alleen nu het liefst nog naar een andere werkmap toe waar ik de overzichten in bij hou.
Hoe kan ik dit het beste oplossen?
We werken trouwens met een server waar alles op staat.
Groet Kevin
Laatst bewerkt: