Copy/Paste issue w/large data set

[adinger]

I wish I could've ben more concise in my subject line, but alas here's my challenge.

I have a large work sheet with two blocks of data feeding off each other with many look ups and formulas.

I need to find a way to copy one cell (say P1) to another cell (Say A1) then do that very same thing 20 rows below the P1 and A1. This also has to be done multiple times. (Say 2,500 times)

i.e. Copy P1 > Paste to A1 > Copy P21 > Paste A21 > Copy P41 > Paste A41....So on and so forth.

Is there a macro, VBA Code or simply a technique out there that would help to keep me from ctrl+c > ctrl+p 2,500 times?

Thanks for the help!!
Andy

 

[HalfAce]

Assuming you'll be running this code with that being the active sheet, how about something like this?

Sub Every20Rows()
Dim LstRw As Long, Rw As Long
LstRw = Cells(Rows.Count, "P").End(xlUp).Row
For Rw = 1 To LstRw Step 20
  Cells(Rw, "P").Copy Cells(Rw, "A")
Next Rw
End Sub

Hope it helps.

 

[adinger]

Thanks for the super quick response!!

This is definitely on the right track.
Here's the actual cells which seem to be the issue with the debug:
Copy AV32 > Paste K6 > Copy AV52 > Paste K7 > Copy AV72 > Paste K8.

So it's not exactly as I initially wrote. The copy is every 20 rows, but the paste is directly underneath each other.
(Sorry for the confusion)

 

[andiemac]

Not as refined as what HalfAce gave, but this sounds like it does what you want.

Sub Paste_20()
Dim SkipRow As Long
Dim NextRow As Long
Dim PasteRow As Long
Dim CopyRow As Long
Dim LR As Long
Range("P1").End(xlDown).Select
LR = ActiveCell.Row
SkipRow = 19
NextRow = 1
PasteRow = 1
CopyRow = 1
For CopyRow = 1 To LR
 
    Range("P" & CopyRow).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A" & PasteRow).Select
    ActiveSheet.Paste
    CopyRow = CopyRow + SkipRow
    PasteRow = PasteRow + 1
Next CopyRow
    
End Sub

 

[HalfAce]

And, if I understand your last post, you can try something like this:

Sub Every20Rows()
Dim LstRw As Long, DestRw As Long, Rw As Long
LstRw = Cells(Rows.Count, "AV").End(xlUp).Row
DestRw = 6 'Change 6 to the real row you want to start pasting in.
For Rw = 1 To LstRw Step 20 'Change 1 to the real row you want to start from.
  Cells(Rw, "AV").Copy Cells(DestRw, "K")
  DestRw = DestRw + 1
Next Rw
End Sub

Hope it helps.

 

[adinger]

Thanks HalfAce...That was really close!
Let me try one more time to explain what I'm actually doing and if there's no solution I'll go back to the manual way of accomplishing this task.

In cell K6 I'm actually typing in =AV32 then in cell K7 I'm typing in =AV52 then in cell K8 I'm typing in =AV72 and so on and so forth for about 2,500 cells. (At this point I'm at cell K459 which has =AV9012)

I hope this makes more sense than my more recent posts.

HalfAce, your code ran, but didn't import the correct data for some reason and I'm not a coder by any stretch of the imagination.

Thanks again for the help!!

 

[HalfAce]

OK, this is a bit off from what I thought we were doing, but if I understand what you're saying now, then perhaps this:

Sub Demo3()
Dim CopyRow As Long, PasteCell As Range
CopyRow = 32
For Each PasteCell In Range("K6:K459")
  PasteCell.Formula = "=AV" & CopyRow
  CopyRow = CopyRow + 20
Next PasteCell
End Sub

Is that what you're wanting to do?

 

[adinger]

HalfAce, that not only was exactly what I needed, but it also exposed some flaws in the workbook that we surely would not have found with such a beast of sheet. (It's almost 100k rows of data at this point.)

A million thank you's for the help!!!

All the best,
AD

 

[HalfAce]

A million 'you're welcomes'!
(or at least 100K, right?)