need macro to copy and paste cells from place to place

[condo0000]

Hi there,

I am looking for an example macro that will copy and paste some data. Here is the scenario...I have a column of data from A3 to A406. I would like a macro that can copy data from cell A3 and paste in A408, then copy A4 and put it in A416 than copy A5 and paste into A424, etc... All help would be greatly appreciated.

Thanks,
Craig

 

[Mudface]

For your specific example, the following seems to work OK: -

Public Sub CopyCells()
Dim x As Variant
Dim y As Integer
Dim z As Integer
Dim w As Integer

Application.ScreenUpdating = False
z = 1
y = 408
x = Range(Cells(3, 1), Cells(406, 1))
For w = LBound(x) To UBound(x)
    Cells(y, 1) = x(z, 1)
    z = z + 1
    y = y + 8
Next w
Application.ScreenUpdating = True
End Sub

This message was edited by Mudface on 2002-09-05 13:55

 

[Jim North]

Here's my version:

<pre>
Sub CpyPste()

Dim Sell As Range
Dim NewRow As Long
Dim Rng As Range

' turn off screen updating
Application.ScreenUpdating = False

NewRow = 408

Set Rng = Range("A3:A406")
For Each Sell In Rng

Rows(Sell.Row & ":" & Sell.Row).Select
Selection.Copy
Rows(NewRow & ":" & NewRow).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
NewRow = NewRow + 8

Next Sell

Range("A1").Select

Application.ScreenUpdating = True

End Sub
</pre>

 

[Mudface]

Beat you by about 0.82 of a second, Jim .

 

[Jim North]

Mudface...

Actually 15 minutes... but I had someone come in my office and expect me to do REAL work! The NERVE of some people!

 

[Mudface]

Sorry, I was talking about the time taken to copy the cells. Mine took about 0.05 seconds, your original took 0.87 seconds. A rejigged version of yours, below, takes about 0.55 seconds. God, how bored am I, off work for 4 days with gastric 'flu and stir-crazy

Sub CpyPste()

Dim Sell As Range
Dim NewRow As Long
Dim Rng As Range

' turn off screen updating
Application.ScreenUpdating = False

NewRow = 408

Set Rng = Range("A3:A406")
For Each Sell In Rng

   Rows(Sell.Row & ":" & Sell.Row).Copy Rows(NewRow & ":" & NewRow)
   Application.CutCopyMode = False
   NewRow = NewRow + 8

Next Sell

'Range("A1").Select

Application.ScreenUpdating = True

End Sub

 

[Jim North]

Ahh.. but yours only copies a cell, MINE copies the entire row... so in essence I am doing 255x more work that yours!

Sorry to hear you are down... hope you are at the end!

_________________
JRN

Excel 2000; Windows 2000
This message was edited by Jim North on 2002-09-06 04:41

 

[condo0000]

...Thanks to you both for replying. I will be able to use this and make my application work. What a great board!!