Cellen kopieren naar ander blad

[drethebest]

Ik heb in sheet 1 cellen welke ik per rij wil kopieren naar de eerstvolgende lege rij van sheet 2 indien cel E2 de tekst "ja" bevat. Zie atachment. Dit mag automatisch of via een drukknop. Is er iemand die mij kan helpen?

 

[Nicj56]

Drethebest,

Waar is je attachment?

 

[danny147]

Beste drethebest :thumb:

Moeten de weggeschreven rijen blijven staan of moeten deze verwijderd worden.

Groetjes Danny. :thumb:

 

[drethebest]

Ik kan mijn attachment er niet inplakken (krijg foutmelding).

Eerste werkblad is een overzicht van alle gegevens:

Firma Naam Adres Aantal personen Deelname
De Zon Peeters Mark Kerkweg 25 Lier 3 JA
De Maan Kaas Ivo Paalstraat 2 Brussel Neen
De ster De Lyer Kris Dorpstraat 5 Lint 4 JA

Bedoeling is dat als de deelname "JA" is, de andere cellen van die rij gekopieerd worden naar een volgend tabblad. Gegevens moeten op tabblad 1 blijven staan.

Voorbeeld werkblad 2:

Firma Naam Adres Aantal personen Deelname
De Zon Peeters Mark Kerkweg 25 Lier 3 JA
De ster De Lyer Kris Dorpstraat 5 Lint 4 JA

Alvast bedankt.

 

[danny147]

Beste drethebest

Zie bestandje.

Groetjes Danny. :thumb:

 

[drethebest]

Bedankt! Dat was wat we zochten.

 

[danny147]

Beste drethebest

Graag gedaan

Kan je dan de vraag op opgelost zetten, bovenaan je eerste vraag.

Groetjes Danny. :thumb:

 

[Cobbe]

Ik heb bij wijze van spielerei een kleine toevoeging gedaan aan de oplossing van Danny.
Want als je per ongeluk een 2de keer op de button drukt kloppen de weggeschreven gegevens niet meer.

 

[drethebest]

Bedankt maar stel dat ik bij het overzetten van de gegevens enkel "firma" en "naam" wil overdragen naar het tweede werkblad in plaats van "entire.row". Hoe zou ik dit dan oplossen?

 

[drethebest]

Kan je me bovendien uitleggen wat het verschil is met het eerste document? Zie het probleem niet, werkt volgens mij perfect.

 

[Cobbe]

Sub Kopie()
    Dim x      As Long
    Dim y      As Long
    Dim c      As Variant
    x = Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row
    y = 1
    For Each c In Range("E1:E100")
        If c = "JA" Or c = "ja" Or c = "Ja" Or c = "jA" And c.Offset(, 1) <> "OK" Then
            [COLOR="red"][B]Range("A" & c.Row & ":B" & c.Row)[/B][/COLOR].Copy Sheets("Blad2").Range("A" & y).Offset(1, 0)
            c.Offset(, 1) = "OK"
            y = y + 1
        End If
    Next c
End Sub

Wat het verschil is met het eerste bestand is dat er na het wegschrijven een OK gezet wordt achter betreffende regel, zodat bij een volgende aktie deze regel niet nogmaals wordt weggeschreven.

 

[drethebest]

Bedankt, ik ga het direct proberen!

 

[drethebest]

Dat werkt zeer goed bedankt. Mijn volgend probleem is dat ik ook een tweede kolom heb toegevoegd "shuttle". Indien daar een kruisje staat, zouden ook de gegevens in kolom B, C, en D naar tabblad 3 geschreven moeten worden:

# Firma First name Last name Hotel OK! shuttle OK!
1 een ann jansen x OK x
2 twee elke peters x
3 drie piet geens x OK
4 vier pim pim x OK
5 vijf pam pam x
6 zes pet pet x OK x


Ik dacht dat ik dit zelf kon aanpassen maar het is me niet gelukt. (kan ook nog steeds geen bestand toevoegen)

Alvast bedankt!