Copying row using if function

[Greg B...]

Hi all

How do I want to select all the entire rows with the name yes from sheet
1and get them pasted on to sheet 2

How do you suggest to do this

TIA

Greg

 

[Bernie Deitrick]

Greg,

If your "yes" values are in the first column of a table starting in cell A1
on Sheet1, then

Sheets("Sheet1").Range("A1").AutoFilter _
Field:=1, Criteria1:="Yes"
Sheets("Sheet1").Range("A1").CurrentRegion.SpecialCells _
(xlCellTypeVisible).Copy _
Sheets("Sheet2").Range("A1")

HTH,
Bernie
MS Excel MVP

 

[Tom Ogilvy]

Assume Yes or no is in column 3
Sub CopyData()
Dim rng as Range, cell as Range, col as Long
Dim rw as Long
col = 3
rw = 2
With Worksheets("sheet1")
set rng = .range(.cells(2,col),.cells(rows.count,col).End(xlup))
End with
for each cell in rng
if lcase(cell.value) = "yes" then
cell.EntireRow.copy Destination:=worksheets("sheet2") _
.cells(rw,1)
rw = rw + 1
end if
Next
End Sub

There are certainly faster ways to do it, but this should work and should be
easy to understand.

 

[Greg B...]

Sorry to be a pain again

I tried to make it easier to understand but I have now totally confused
myself again.

What I tried to do is a if function where if the date of the entry is more
than 2 years old mark it as yes.

Then I wanted a control to copy all the yes answers and place then on sheet
2 here is a diagram

date comment
21 feb 2002 back from school yes <- this will be hidden in white
text.

I want it to the copy from sheet 1 to sheet 2 and delete the entry from
sheet 1.

I am sorry to be such a pain but I am struggling with this vba language.

Greg

 

[Tom Ogilvy]

Sub CopyData()
Dim rng as Range, cell as Range, col as Long
Dim rw as Long, rng2 as Range
col = 3
rw = 2
With Worksheets("sheet1")
set rng = .range(.cells(2,col),.cells(rows.count,col).End(xlup))
End with
for each cell in rng
if lcase(cell.value) = "yes" then
cell.EntireRow.copy Destination:=worksheets("sheet2") _
.cells(rw,1)
rw = rw + 1
if rng2 is nothing then
set rng2 = cell
else
set rng2 = union(rng2,cell)
end if
end if
Next
if not rng2 is nothing then
rng2.EntireRow.Delete
End if
End Sub

 

[Greg B...]

Thankyou Tom

Sorry for the late reply Is there a chance to have that formula insert the
new cells above the previous entries

It does everything but copies over the top

Thanks in advance

Greg

 

[Tom Ogilvy]

A later post indicates you solved it.