Uitsorteren

[cverkooyen]

Hey, ik heb even een excel bestand bijgevoegd ter verduidelijking. Ik wil op blad 1 merken kunnen invullen met nog wat opties, 5 velden onder elkaar per onderdeel. Daarna moet je op de button sorteren klikken en zou per merk alles gesorteerd op een eigen tabblad moeten verschijnen. Momenteel werkt het sorteren goed alleen schrijft hij alles op het juiste tabblad in kolom A dus de waardes worden overschreven. Hoe kan ik dit oplossen?

Nog een klein puntje, als ik op tabblad 1 een formule in een veld zet word deze mee gekopieërd, hoe kan ej alleen de uitkomst meenemen?

 

[Demeter]

'maak kolom A op blad 2 leeg
Sheets(2).Range("A:A").Delete

For Each c In Sheets(1).Range("B1:H1")

    If (c = "Mercedes" And c(2) = 52) Then
        legeregel = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
        c.Resize(5).Copy Sheets(2).Range("A" & legeregel)
    End If

Ik zou mijn gegevens onder elkaar gaan plaatsen, alleen omdat ik ook niet weet hoe je een lege kolom kan zoeken.

Hiermee kan je misschien je probleem veraneren. Tevens zou ik mijn merken en kleuren mbv validatie in laten voeren, heb je een mooi controle op je spelling.

Groet,
Ferenc

 

[cverkooyen]

Dat sorteren is inmiddels gelukt!

 

[Demeter]

Hoe heb je het opgelost? alles onder elkaar gezet? ben erg benieuwt .

Voo het plakken: probeer eens via de macrorecorder plakken speciaal/waarden ? denk wel dat je er zo uit moet komen.

Groet,
Ferenc

 

[cverkooyen]

Ik heb deze macro gebruikt:

Private Sub CommandButton1_Click()

Dim c As Range
For Each c In ActiveSheet.UsedRange
    If (c = "Mercedes" And c(2) = 52) Then
        c.Resize(5).Copy Sheets(2).Range(c.Address)
    End If
    If (c = "Mercedes" And c(2) < 52) Then
        c.Resize(5).Copy Sheets(3).Range(c.Address)
    End If
    If (c = "BMW" And c(2) < 52) Then
        c.Resize(5).Copy Sheets(4).Range(c.Address)
    End If
    If (c = "Audi" And c(2) < 52) Then
        c.Resize(5).Copy Sheets(5).Range(c.Address)
    End If
    If (c = "FORD" And c(2) < 52) Then
        c.Resize(5).Copy Sheets(6).Range(c.Address)
    End If
Next c

End Sub

Hij kopieërd alleen ook de formules mee, ik wil dit gaan oplossen door alleen het bovenste veld naar het tabblad te kopieëren dan gewoon =Blad!Veld te gebruiken om de rest van de data over te krijgen. De lege kolommen haal ik er natuurlijk ook nog tussenuit.

 

[Wigi]

Je kan Plakken speciaal gebruiken (met Waarden) ipv. gewoon Plakken. Dan krijg je de formules niet, maar wel de eigenlijke waarden.

EDIT: Sorry, nu pas reactie van Ferenc gelezen hierboven.

Zo doe je Plakken speciaal waarden in VBA:

Range("A1").Copy
Range("B1").PasteSpecial xlPasteValues

Wigi

 

[cverkooyen]

Hey, nog een vraagje hierover. Hoe pas ik dit toe in mijn script? Zie:

Dim c As Range
For Each c In ActiveSheet.UsedRange
    If (c = "Mercedes" And c(2) < 52) Then
        c.Resize(2).Copy Sheets(3).Range(c.Address)
    End If
    If (c = "BMW" And c(2) < 52) Then
        c.Resize(2).Copy Sheets(4).Range(c.Address)
    End If
    If (c = "Audi" And c(2) < 52) Then
        c.Resize(2).Copy Sheets(5).Range(c.Address)
    End If
    If (c = "FORD" And c(2) < 52) Then
        c.Resize(2).Copy Sheets(6).Range(c.Address)
    End If
Next c

Met

If (c = "Mercedes" And c(2) = 52) Then
    
     Range(c.Address).Copy
     Sheets(2).Range(c.Address).PasteSpecial xlPasteValues

        
    End If

Krijg ik alleen de eerste cel mee.