Rijen kopiëren die bepaalde waarde heeft.

[Pieter Bauwens]

Beste,

Ik ben bezig aan een excel bestandje om mijn stock gegevens bij te houden.
Nu zou ik wanneer er in kolom L een aantal staat ingevuld en ik op een knop druk de rijen met aantallen ingevuld willen kopiëren naar een ander blad.

Heb op blad 2 een voorbeeld gezet van wat ik wil door kopiëren en plakken gewoon nu.

Bekijk bijlage Stock test 2.xlsm

Mvg,
Pieter

 

[namliam]

Iets in de trant van...

Sub DoorKopieren()
    
    Dim R As Double
    Range("N3:N22,L3:L22,I3:I22,F3:F22,C3:C22").Copy
    Sheets("blad2").Select
    Range("A1").Select
    If Range("A2") <> "" And Range("A2") <> 0 Then Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    R = ActiveCell.Row
    ActiveSheet.Paste
    Columns("E:E").AutoFilter
    Application.CutCopyMode = False
    
    ActiveSheet.Range("$E:$E").AutoFilter Field:=1, Criteria1:="="
    Rows("2:44").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("A" & R).Select
End Sub

???

 

[Pieter Bauwens]

Beste,
Dat is het dus. Hoe kan ik juist nog een andere volgorde van kolommen krijgen op blad 2.
bv eerst L dan H, C, F, N.

Mvg,
Pieter

 

[namliam]

kwestie van het kolom voor kolom overzetten van je origineel naar het doel

 

[Pieter Bauwens]

Kan ik dit via de VB code?

 

[namliam]

Dan moet je de boel een beetje bewerken, maar ja...
ipv de meerdere ranges
Range("N3:N22,L3:L22,I3:I22,F3:F22,C3:C22").Copy
Alleen een kolom pakken
Range("N3:N22").Copy
en die dan gaan plakken waar je hem wil, etc....

 

[Warme bakkertje]

Sub Doorkopieeren()

    Sheets("blad2").Cells(1).Resize(, 5) = Split("Aantal|Stock|Omschrijving|Verkoopprijs|Prijs", "|")
    With Sheets("magazijn")
        .Columns(12).AutoFilter
        .Columns(12).AutoFilter 1, "<>"
        x = 1
        For Each col In Array("12", "8", "3", "6", "14")
            .Cells(3, CInt(col)).Resize(.AutoFilter.Range.Rows.Count).SpecialCells(12).Copy _
                    Sheets("blad2").Cells(2, x).Resize(.AutoFilter.Range.Rows.Count)
            x = x + 1
        Next
        .Columns(12).AutoFilter
    End With

End Sub

 

[Ralbers]

Ik heb zoiets gemaakt

Zal wel minder efficient zijn
Maar werkt ook vrij snel



Bekijk bijlage Stock%20test%202(1).xlsm

Sub test()
Dim a, b, c, d As Integer
Dim oms, EH As String
Dim pr, aantal As Integer
Sheets("magazijn").Select

b = [aantal_nr] + 20
c = 1

For a = 3 To b Step 1
If Cells(a, 12).Value > 0 Then
Cells(a, 19).Value = 1
oms = Cells(a, 3).Value
EH = Cells(a, 9).Value
pr = Cells(a, 6).Value
aantal = Cells(a, 12).Value
c = c + 1
Sheets("Blad1").Select
Cells(c, 1).Value = oms
Cells(c, 2).Value = pr
Cells(c, 3).Value = EH
Cells(c, 4).Value = aantal
Sheets("magazijn").Select
Else
End If
Next
Sheets("Blad1").Select
Range("E2").FormulaR1C1 = "=IF(RC[-3]*RC[-1]=0,"""",RC[-3]*RC[-1])"
Range("E2").AutoFill Destination:=Range("E2:E50"), Type:=xlFillDefault
Columns("A:E").EntireColumn.AutoFit
End Sub