Find cells with a given value and copy the two cells to the left...

[Phil Smith]

On my worksheet "Roster", I need to find which cells in columns I, M, Q, U & Y contain "SP".

At the moment I am looping through I2:I71, M2:M71, Q2:Q71, U2:U71 and Y2:Y71.

For example, the first cell that contains "SP" is I9. I would then need to copy G9:H9 and paste those values to cells AG4:AH4 on worksheet "Data".

The next instance would then be pasted to AG5:AH5 and so on.

Is there a quicker way rather than looping through each of the 70 rows in each column? Once I have that syntax, I think I can work the rest out.

Thanks in advance!

 

[BobUmlas]

Sub Solution()
On Error Resume Next
r=4
With Sheets("Roster").Range("I2:I71,M2:M71,Q2:Q71,U2:U71,Y2:Y71")
Set cel=.Find("SP",Lookat:=xlwhole)
Set First=cel
Do
If err.number<>0 then exit sub
cel.offset(,-2).resize(1,2).copy Sheet("Data").cells(rw,33)
rw=rw+1
Set cel=.Findnext(after:=cel)
If cel.address=First.address then exit sub
Loop
End With
End Sub

 

[Phil Smith]

Thanks for your solution, however I had to change r=4 to rw=4 to get it to work.

It does what I need with the exception that it copies the formatting as well, whereas I just need the values.

Can that be achieved?

 

[BobUmlas]

The r=4 was a typo, sorry. Yes, it should be rw=4.
The solution is change
cel.offset(,-2).resize(1,2).copy Sheets("Data").cells(rw,33)

to

cel.offset(,-2).resize(1,2).copy
Sheets("Data").Cells(rw,33).Pastespecial xlpastevalues