Waarde voldoet dan copy naar ander werkblad

[McPhone]

Hoi,

Als in een kolom de waarde van een cel veranderd, moeten een aantal cellen van de regel worden gekopieerd naar een andere werkblad.

Bv in kolom K wordt de waarde in K2 "ja" (door een aantal formules). Nu moet A2 t/m J2 worden gekopieerd naar werkblad "AANPASSEN"

Iemand een idee, hoe ik dit kan aanpakken

 

[Ginger]

McPhone, Is het niet gewoon makkelijker om je overzicht te filteren op de kolom met de 'ja' in de regel? Als je dan persé die waarde nog gecopieerd wilt zien, kan je dit doen met advanced filter (je kan de regels alleen naar dezelfde sheet wegschrijven!). Maar gewoon filteren en gelijk de data bewerken lijkt me een stuk minder ingewikkeld.

Groet, Leo

 

[McPhone]

@ ginger:

Is een optie, maar niet goed te gebruiken in mijn bestand

 

[McPhone]

Sub ZetJAinKolomABlad2()
With Worksheets(1).Cells
Dim c As Range
Dim firstAddress As String
Set c = .Find("JA", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Copy Sheets(2).Range("A65536").End(xlUp).Offset(1, 0)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Ik heb de volgende code op het net gevonden, deze doet bijna wat ik wil. Alleen het aanpassen naar wat ik graag wil, daar kom ik niet uit.

Hij kopieert nu alleen de waarde uit kolom A (ik wil A t/m J)
Hij zet het nu op het 2de werkblad (ik wil graag dat het gaat naar blad "AANPASSEN"

Wat moet ik aanpassen om de macro zo te krijgen

 

[McPhone]

Sub CopyJA()

Dim LastRow As Long
Dim X As Long
Dim r As Range
Dim CopyRow As Integer

LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

For Each r In Range("K1:K" & LastRow)
    If r = "JA" Then
        r.EntireRow.Copy
X = X + 1
        Sheets("AANPASSEN").Range("A" & X).PasteSpecial
    End If
Next
End Sub

Kwam dit tegen op het net, dit werkt zoals ik wil

 

[Ginger]

McPhone, Volledig ongetest geef ik je dit antwoord (moet ff vlug)
Vervang deze regel

c.Copy Sheets(2).Range("A65536").End(xlUp).Offset(1, 0)

voor deze

c.EntireRow.Copy Sheets("AANPASSEN").Range("A65536").End(xlUp).Offset(1, 0)

Maar mijn vermoeden zegt dat ie 't zo zou moeten doen...

Groet, Leo

 

[Wigi]

Of vervangen door:

Range("A" & c.Row, "J" & c.Row).Copy Sheets("AANPASSEN").Range("A65536").End(xlUp).Offset(1, 0)