Copy cell 6 times and paste the step and copy next cell

[saxjammin]

Help please I urgently need a a macro if possible to run this but if there is another way that is fine. I struggled yesterday to find a way.

I have a list of items in column AF4 to AF763 I need to copy each one 6 times into column AK4 and then step 20 the start of next one in list then repeat the same from AF5 down the list.

I can possibly do it if I can get the first one in list to copy and step 20 then copy the next in list to the end of list.

Thank you

 

[saxjammin]

Hi I am relatively new to this but i manage with help, I think because i usually use a command button but did not know how to configure it with the code you provided anyway I managed to find the run sub button which is the first time for me to use that. I appreciate your help but it does not do what I would like it is keeping the first one on list then deleting the next six which are blank cells then listing the next 20 I actually want it to copy the cell in AF4 and paste it 6 rows down from AK4 then leave 20 blank cells and repeat the cycle from AF5 which is the next in list that i want copying 6 times down after the 20 blank cells

 

[Fluff]

@saxjammin
Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread. (rule 12 here: Forum Rules).

I have merged both threads

 

[saxjammin]

i do apologise, as you probably know i am new here and only been on once before, I thought the first thread had not posted that is why i posted a second time

 

[Yongle]

Try this
- amend sheet name

Sub CopyBikes()
    Dim ws  As Worksheet:       Set ws = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
    Dim shed    As Range:       Set shed = ws.Range("AF4:AF763")
    Dim road    As Range:       Set road = ws.Range("AK4").Resize(6)
    Dim bike    As Range
    Application.ScreenUpdating = False
    For Each bike In shed
        bike.Copy road
        Set road = road.Offset(26)
    Next
End Sub

 

[My Aswer Is This]

My code and Yongle code does exactly the same except Yongle uses copy.
If were just using values and do not need to copy formatting my code is much quicker.

But your saying my code does not work.

I test all my scripts and this script does do what you asked for as far as I can see.

 

[steve the fish]

If you wanted speed this would be quicker still:

Dim arr, arr2, i As Long, j As Long

With Sheets("Sheet1")
    arr = .Range("AF4:AF763")
    ReDim arr2(1 To UBound(arr) * 26)
    For i = 1 To UBound(arr, 1)
        For j = 1 To 6
            arr2((i - 1) * 26 + j) = arr(i, 1)
        Next
    Next
    .Range("AK4:AK19763") = Application.Transpose(arr2)
End With

 

[gssachin]

Hey saxjammin,

His code working perfectly. I also tried.

As I understand you want AF4 value to be copied to AK4 to AK9 and then get 20 empty rows and then next AF5 value to copy to AK30 and do for all in AF column
if you don't want like this then provide example with answer how you required then these master can help you

 

[saxjammin]

copy range of cells from column, paste and offset

Can anyone help with this please I have reference data in column AM4:AM4563 starting from AM4 I need to extract 6 rows and paste into AW4 and then leave 4 blank rows then repeat from the next 6 in the reference list

please see image example

https://www.dropbox.com/s/gssr2pz7ps...81%29.png?dl=0

 

[saxjammin]

thank you for this response and code it works but not correctly from the list AF4:AF763 i need it to copy the first 6 and paste them to AK4 then leave 20 blank rows after this i need it to go back to AF10 and select the next 6 from the list and paste to AK30 please see this link thank you

your code is selecting 6 and the 20 blank rows but the six that are selected repeat 6 times instead of only once

https://www.dropbox.com/s/gssr2pz7ps...81%29.png?dl=0

 

[MickG]

Ref Post#18
Try this:-

[COLOR="Navy"]Sub[/COLOR] MG10Jun15
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = Range("AM4:AM4563")
    ReDim nray(1 To UBound(Ray, 1) + UBound(Ray, 1) / 6 * 4, 1 To 2)
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    c = c + 1
    nray(c, 1) = Ray(n, 1)
    [COLOR="Navy"]If[/COLOR] n Mod 6 = 0 [COLOR="Navy"]Then[/COLOR] c = c + 4
[COLOR="Navy"]Next[/COLOR] n
Range("AW4").Resize(c).Value = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick