Kopieren en plakken als waarde van een hele rij op basis van een criterium

[s_goudsblom]

Hallo allemaal ik heb de volgende sheet.



Wat ik wil is de waarden uit de tabel in deze sheet naar een volgende sheet kopiëren als de waarde in de eerste kolom "N" is. Dit doe ik met de volgende macro;

Sub CopyRow()
Dim r As Integer
Dim cell As Range
r = 9
For Each cell In Selection
If cell.Value = "N" Then
cell.EntireRow.Copy Sheets("Sheet2").Cells(r, 1)
r = r + 1
End If
Next cell
End Sub

Hiermee worden keurig alle rijen in de selectie gekopieerd, die voldoen aan de voorwaarde, naar sheet2 vanaf rij 9 (variabele r) en verder.

Het enige wat ik nog wil toevoegen is dat alleen de waarden gekopieerd (paste values) worden.

Kan iemand mij hierbij helpen, alvast bedankt!

Groet Sander

 

[s_goudsblom]

Gevonden!!

Sub CopyRow()
Dim r As Integer
Dim cell As Range
r = 9
For Each cell In Selection
If cell.Value = "N" Then
cell.EntireRow.Copy
Sheets("Item Data").Cells(r, 1).EntireRow.PasteSpecial xlPasteValues
r = r + 1
End If
Next cell
End Sub

Alleen is het een stuk trager als de eerste macro, iemand daar nog een oplossing voor?

 

[snb]

Waarom gebruik je geen autofilter, dan kun je in 1 keer alles kopiëren.

 

[s_goudsblom]

Deze macro komt onder een knop heb ondertussen de code alweer aangepast;

Sub CopyRowInputItem()
Dim r As Integer
Dim cell As Range
r = 9
For Each cell In Worksheets("Input - Item").Range("A9:A200").Cells
If cell.Value = "N" Then
cell.EntireRow.Copy
Sheets("Item Data").Cells(r, 1).EntireRow.PasteSpecial xlPasteValues, SkipBlanks:=True
r = r + 1
End If
Next cell
End Sub

 

[edmoor]

Alleen is het een stuk trager als de eerste macro, iemand daar nog een oplossing voor?

Begin je code met Application.ScreenUpdating = False
En eindig dan met Application.ScreenUpdating = True

 

[s_goudsblom]

Dat is inderdaad een stuk beter!! Dank je :thumb: