rijen kopieren op voorwaarde

[flupje]

Beste,

Ik ben op zoek naar een methode waarbij er rijen worden gekopieerd naar een ander werkblad indien er aan een bepaalde voorwaarde voldaan is.

In werkblad 2 staat een lijst van componenten met hun eigenschappen. Als er een bepaalde eigenschap boven de 50 gaat, dan zou ik die component met eigenschappen in werkblad 3 willen plaatsen (automatisch).

Bestaat er een mogelijkheid voor?


Mvg

Filip

 

[Wigi]

Hello

in deze thread heb ik code opgepost om zoiets te doen. Kijk er eens naar, ook naar het bestand dat daar toen gebruikt werd.

Wigi

 

[flupje]

opmerking

De code lijkt te werken indien er een werkelijke waarde in de kolom staat.

nu staat er in de kolom een formule. En de uitkomst van de formule wordt niet beschouwd als case in de programmacode


Alvast bedankt

Mvg

Filip

 

[Demeter]

Post eens een voorbeeldje, dit verteld meer dan 1000 woorden.
Dan kunnen we er hier een code voor maken.

Groet,
Ferenc

 

[flupje]

voorbeeld

Beste,

in bijlage heb je een voorbeeld.
In het ws "werkdatabase" moeten er gegevens gekopieerd worden naar ws "overzicht comp" afhankelijk of de waarde in kolom D groter is dan 50.


Mvg

Filip

 

[Demeter]

Tjek deze eens.
Het bereik kan je nog aanpassen zodat hij alle rijen neemt welke gevuld zijn.
kom zo snel niet op de code.

Groet,
Ferenc

 

[flupje]

Bedankt

Bedankt,

alles werkt naar wens!!


Mvg
Filip

 

[Demeter]

Een aangepaste code voor je probleem + uitleg:

Sub overzetten()
Dim c As Range

'Range zou je nog dynamisch kunnen maken (mijn kennis schiet hier te kort om dat in een hand omdraai te doen. :(
'maak cellen A8:B103 leeg
Sheets("Overzicht comp").Range("A8:B103") = ""

'Kijk in bereik D3:D103 naar de inhoud
For Each c In Worksheets("werkdatabase").Range("D3:D103") 'Range zou je nog dynamisch kunnen maken (mijn kennis schiet hier te kort om dat in een hand omdraai te doen. :(
'als inhoud van de cel groter is dan 49
    If c > 49 Then
'welke regel is de eerst lege in het blad 'overzicht comp'
        legeregel = Sheets("Overzicht comp").Range("A" & Rows.Count).End(xlUp).Row + 1

'plak gegevens de cellen
        Sheets("Overzicht comp").Range("A" & legeregel) = c.Offset(, -3)
        Sheets("Overzicht comp").Range("B" & legeregel) = c
    End If
Next

'activeer het werkblad 'overzicht comp'
Sheets("Overzicht comp").Activate
    
End Sub

Dee maakt nu eerst het te plakken bereik leeg, zodat je nooit 2x dezelfde info in je blad het staan.
Dynamische bereiken schud ik zelf niet oz 1, 2, 3 uit mijn mouw.

Succes,
Ferenc