Kopieer regel als kolom i ja is

[HWV]

Vandaag kwam Trucker 10 met een oplossing voor een topic.
Ik zat met het zelfde probleem en heb de code overgenomen van Daniel.

Het werk als in mijn geval de Ja in kolom I onderelkaar staan zonder dat er een lege regel is.
Im mijn geval is het dus in kolom I;
ja

ja



ja

Met de volgende code pakt hij enkel de eerste regel met als waarde ja in kolom I

Sub Kopie()
    Dim x      As Long
    Dim y      As Long
    Dim c      As Variant
    x = Sheets("Werkmap").Cells(Rows.count, "J").End(xlUp).Row
    y = 1
    For Each c In Range("J1:J10000")
        If c = "ja" Then
            c.Rows.EntireRow.Copy Sheets("Herbevoorrading 152").Range("A" & y).Offset(1, 0)
            y = y + 1
        End If
    Next c
End Sub

Hoe moet ik de code aanpassen zodat hij nu wel alle regels met een ja uit een kolom pakt

Groet HWV

 

[brandernl]

Je doet niets met de x
Een variant gebruikt veel geheugen heb ik me laten vertellen
Ik zou het zo doen:

Sub Kopie()
    Dim c      As Range
    For Each c In Range("J1:J10000")
        If c = "ja" Then
            c.Rows.EntireRow.Copy Sheets("Herbevoorrading 152").Range("A" & y).Offset(1, 0)
       Next 
End Sub

 

[Warme bakkertje]

In je vraagstelling spreek je van kolom I maar in je code kolom J????

Sub Kopie()
   Dim c As Range
   For Each c In [I1:I10000]
        If c = "ja" Then
            c.Rows.EntireRow.Copy ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0)
        End If
    Next
End Sub

 

[brandernl]

Ik wist niet dat dit

[J1:J10000]

ook een geldige Range is.
Dank!

 

[HWV]

Kopieer op waarde

Sub KOPIEEREN()
    Dim c      As Range
    For Each c In Range("J1:J10000")
        If c = "ja" Then
            c.Rows.EntireRow.Copy Sheets("Herbevoorrading 152").Range("A" & y).Offset(1, 0)
       End If
       Next
End Sub

Beste,

Ik kreeg nog een aantal fouten.
Eerst next zonde for.
Next weg gehaald toen de fout for zonder end.
Aangepast maar krijg nog geen resultaat.

Volgens mij moet nu alle goed staan maar werkt helaas nog niet.

Sub Kopie()
   Dim c As Range
   For Each c In [I1:I10000]
        If c = "ja" Then
            c.Rows.EntireRow.Copy ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0)
        End If
    Next
End Sub

Rudi op één of ander manier gaat het niet goed, ik krijg hem niet aan de gang.
Ik enkel even de kolom van I veranderd in J

*********
Ik kom er nu net dus achter dat als ik ene blad neem zonder formule`s in de regel dat hij dit dan wel overneem.
Er staan twee kolomen met formule`s in die als waarde moeten worden weggeschreven.
Had misschien een punt moeten zijn om te vermelden.


Groet HWV

 

[brandernl]

Beste HWV
In die van mij zat nog een foutje, omdat ik de variabele y niet gedefinieerd had, maar dat is zo niet nodig.
En die van Warm Bakkertje keek naar kolom I en daar staat geen "ja"

Deze werkt als een speer:

Sub Kopie()
   Dim c As Range
   For Each c In [J1:J10000]
        If c = "ja" Then
            c.EntireRow.Copy ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0)
        End If
    Next
End Sub

 

[Warme bakkertje]

Het werk als in mijn geval de Ja in kolom I onderelkaar staan zonder dat er een lege regel is.
Im mijn geval is het dus in kolom I;

Daarom dat er zo dikwijls om een voorbeeldbestandje gevraagd wordt

 

[HWV]

Formule in regel

Sub Kopie()
   Dim c As Range
   For Each c In [J1:J10000]
        If c = "ja" Then
            c.EntireRow.Copy ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0)
        End If
    Next
End Sub

De code werkt als er geen formule`s in de regels staan die omgezet moeten worden naar waarde.

Zonder formule`s in de regel gaat hij als een speer inderdaad.

Waar hij de bestanden vandaan haal moeten de formule`s blijven staan.
Ik heb al geprobeerd om .PasteSpecial xlValues er bij toe t evoegen maar lukt me niet echt

Om nog wat aanvulling te geven.
In mijn orginele bestand begin de eerste Ja pas op regel 162
Als ik op regel 2 3 4 een ja zet pak hij alleen deze over !

Groet HWV

 

[Warme bakkertje]

Met formules in kolom D en E

 

[HWV]

Ik weet het niet meer

Rudi,

In de bijlage het bestand wat je heb bewerkt en dat doet het goed.
Ik heb nu twee regels toegevoegd uit mijn oorspronkelijke bestand.

En die slaat hij over! ik snap er nu niks meer van.

Misschien kan jij zien waar het aan ligt.

Groet Henk

 

[Wigi]

En die slaat hij over! ik snap er nu niks meer van.

Als ik de macro kopie uitvoer, worden er 6 rijen op het tweede blad gezet.

Waarom gebruik je overigens geen autofilter of uitgebreide filter?

Met zo weinig rijen als hier valt dit mee, maar van lussen over 10000 rijen wordt men over het algemeen ook niet vrolijk.

Wigi

 

[HWV]

Autoflter

Beste Wigi
Bedankt voor uw reactie, op mijn topic.

Ik krijg ook de 6 regels maar niet de regels 22 en 24
De laatset twee die deel uitmaakt van de 6 zijn geplaats door warme bakkertje op regel 152 en 10000.
Als ik de Ja zelf in type in regel 22 en 24 dan doet de code het wel . Kan dit zijn dat dit eerst een formule is geweest en is om gezet?

Waarom ik het op deze manier doet is omdat dit een onderdeel is van een conversie
en dit zoveel mogelijk via VBA wil laten lopen om straks zo min mogelijk handmatig te doen.

Ik hoop dat dit op te lossen is.
Ik wil wel alvast een ieder bedanken voor zijn hulp.

Groet HWV

 

[Wigi]

Ik krijg 8 regels op blad 2, ook als ik bvb. dit in cel J22 zet:

=ALS(K22=1;"neen";"ja")

Er komt dan ja te staan als resultaat van een formule. Die wordt ook meegekopieerd.

Formule of niet, dat mag geen verschil uitmaken.

Wigi

 

[HWV]

gaat niet lekker

Beste Wigi,

Wat ik niet kan begrijpen dat bij U het bestandje het wel doet.
Ik heb daarom weer een orgineel stuk uit mijn data in een bestand gezet.
En deze doet het ook niet.
Als U naar mijn dat wil kijken kunt u misschien zien waar het verkeerd gaat.

Met vriendelijke groet,

Henk

 

[Wigi]

Ja is niet hetzelfde als ja.

 

[trucker10]

Topic niet kunnen volgen even op de baan geweest

If c = "ja" Then

aan de hand van het antwoord van Wigi kan ik afleiden dat een typo de macro niet laat werken

If c = "ja"  Or c = "Ja" Or c = "JA" Or c = "jA" Then

dan mag je een andere schrijfwijze toepassen , ik lees straks wel alles eens door .

 

[Wigi]

If ucase(c) = "JA" Then

of bekijk de Option Compare statements eens.

Maar vooral, doe deze hele oefening met een filter (niet manueel maar met VBA-code).

Wigi

 

[HWV]

mischien iets waar hij op vast loop

Sub Kopie()
    Application.ScreenUpdating = False
   Dim c As Range
   For Each c In [J1:J10000]
        If UCase(c) = "JA" Then
            c.Rows.EntireRow.Copy
            ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Totzover de code, ik heb nu handmatig de N/B weg gehaald en de code gaat er nu wel overheen en doet wat hij moet doen.
Hoe kan ik op een snelle manier deze N/B weg krijgen zodat de code wel gaat lopen.



Groet Henk

 

[Wigi]

Hoe kan ik op een snelle manier deze N/B weg krijgen zodat de code wel gaat lopen.

Selecteer de kolom, druk F5, dan Speciaal..., dan Constanten en fouten, en dan de Delete knop indrukken.

Wigi

 

[trucker10]

Beste HWV , ik mag > ja , Ja , JA , jA invullen bij mij werkt de macro die in dit bestandje zit

Sub Kopie()
    Application.ScreenUpdating = False
   Dim c As Range
   For Each c In [J1:J10000]
        If c = "ja" Or c = "Ja" Or c = "JA" Or c = "jA" Then
            c.Rows.EntireRow.Copy
            ['Herbevoorrading 152'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub