# Macro to copy cells with criterion

#### timjohnny

##### New Member
Hi all,

I hope everyone's doing well! I've come up with something I want to do and have written out what I think the code may roughly need to look like
(using bits and bobs from previous help I've gotten here on Mr Excel),
but my skills unfortunately aren't at the point yet where I know how to write it so that it works. So I hoped maybe one of you can tell me where
I went wrong, how I can write it correctly.

So I have a set of data that looks like this:

Now, I want to have a macro that copies over the three cells on the left (i.e. the comic names) to another sheet if the value of the relavant
cell to the right of them is larger than 0. Which one is the relavant cell, I specify by writing the column number into another cell, say cell A1 on Sheet2.
The macro would then move onto the next row and do the same, copying the three cells in columns A B and C over into the three cells adjacent to the ones that
the above row was previously copied into. So for the above data, that row in sheet3 (target sheet) would look like this if cell A1 in sheet2 says 4:

I imagine the code would need to look a bit like what I have below (I have to run this through 250 rows btw), would be super grateful for any suggestions how to make it work:

VBA Code:
``````Sub copy_cartoons()
Dim k As Long
Dim j As Variant

j = sheets("Sheet2").Range("A1").Value

With Sheets("Sheet1")
For k = 2 To 251
if .Cells((k,j).Value > 0 Then
.Range("A" & k).Resize(, 3).Copy Sheets("Sheet3").Cells(4, k * 3 - 1)
Next k
Next j
End With
End Sub``````

Thanks!

Last edited by a moderator:

### Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

#### Peter_SSs

##### MrExcel MVP, Moderator
When posting vba code, please use the available code tags. I have added them for you this time. More information is in my signature block below.

I think you were pretty close. I've modified it a bit. Test with a copy of your workbook.

VBA Code:
``````Sub copy_cartoons_v2()
Dim k As Long, j As Long

j = Sheets("Sheet2").Range("A1").Value
With Sheets("Sheet1")
For k = 2 To .Range("A" & Rows.Count).End(xlUp).Row
If .Cells(k, j).Value > 0 Then .Range("A" & k).Resize(, 3).Copy Sheets("Sheet3").Cells(4, k * 3 - 1)
Next k
End With
End Sub``````

#### Peter_SSs

##### MrExcel MVP, Moderator
.. or perhaps it is a bit more like this that you want?

VBA Code:
``````Sub copy_cartoons_v3()
Dim k As Long, j As Long

j = Sheets("Sheet2").Range("A1").Value
With Sheets("Sheet1")
For k = 2 To .Range("A" & Rows.Count).End(xlUp).Row
If .Cells(k, j).Value > 0 Then .Range("A" & k).Resize(, 3).Copy Sheets("Sheet3").Cells(4, Columns.Count).End(xlToLeft).Offset(, 1)
Next k
End With
End Sub``````

#### timjohnny

##### New Member
Hi Peter,

Thanks a lot for your help! I'm going with the first option feels good that I got so close myself, making progress it seems ^^
Thanks again!

Best
Tim

#### Peter_SSs

##### MrExcel MVP, Moderator
Thanks a lot for your help!
You're welcome. Thanks for the follow-up.

feels good that I got so close myself, making progress it seems ^^
Stick with it and progress will continue.

Replies
4
Views
168
Replies
7
Views
206
Replies
5
Views
233
Replies
3
Views
137
Replies
7
Views
104

1,181,612
Messages
5,930,921
Members
436,766
Latest member
azex85

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back