Copy every single row in to 4 rows

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello,</SPAN></SPAN>

Every single row of the Data columns C:P, I want to copy into 4 rows in the columns R:J </SPAN></SPAN>

Example for row 6...copy as follow</SPAN></SPAN>
C6:F6, copy in to R6:U6</SPAN></SPAN>
G6:J6, copy in to R7:U7</SPAN></SPAN>
K6:M6, copy in to R8:T8</SPAN></SPAN>
N6:P6, copy in to R9:T9 </SPAN></SPAN>
In brief row 6 copy in to cells R6:U10</SPAN></SPAN>
In brief row 7 copy in to cells W6:Z10</SPAN></SPAN>
In brief row 8 copy in to cells AB6:AE10</SPAN></SPAN>
In brief row 9 copy in to cells AG6:AJ10</SPAN></SPAN>

Copy the same way next 4 rows, 2 steps below the first 4 rows in to R12:AJ15...all till end will follow with same method</SPAN></SPAN>

Here is an example... </SPAN></SPAN>


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJ
1
2
3
4
5n1n2n3n4n5n6n7n8n9n10n11n12n13n14ABCDABCDABCDABCD
6212364740312832028912441821236472986241715333029172912
729862444822471739431153440312834482247301063629333222
81715333030106361036421534320289173943103642291713
9291729122933322229171311206124418115341534311206
103927272732471811473047430
11212032214228163018461094333
121929122493932742182943204939272721203221192912239171827
133917182721202932481528352692732471842281630493932721202932
14584023711255244745311832114730184610421829481528
15351718341218244423145034474309433343204935269
16135241242339304364103240
172526113552117591441343942
189102243614923738712541
19251941271230421846338193131
2030251524315416423826122211
2137137418354947172091330
22392302136724632131282617
23430194041336337474644127
242411102447372813402114529
2533334310197313632131636
26124239303837394917444482525
2771342373223384530233330814
28451235232615322516200371734
2936482301536165384034273041
3053113369308262171122917
31461738496202243204822163422
32242933222127371535444942340
333846731104834139726131640
344336173474741416252125
35283640474304501122443115
3615277170491717292846453632
3722525131845134240387799
384429431935103531131545223044
3928724196333294913915537
40728382553248104744471205
41351021306251244463425361143
42311224158412221439454201
4348282134292523312873310
4415331538443516154850285
454331222613274771011911128
461482182425182212511383712
472648304816261639403037122343
4844836227124630484013434911
4922454297131347122226314937
Sheet1


Thank you all</SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Try this for results starting "R6".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG28Jan46
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, colsA [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ColsB [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] v [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = Range("C6", Range("C" & Rows.Count).End(xlUp)).Resize(, 14)

ReDim nray(1 To UBound(Ray, 1) * 2, 1 To 20)
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    colsA = Array(1, 5, 9, 12, 20)
    ColsB = Array(0, 5, 10, 15)
    p = 0
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 14
        [COLOR="Navy"]If[/COLOR] Ac = colsA(p) [COLOR="Navy"]Then[/COLOR]
            Rw = Rw + 1
            p = p + 1
            c = ColsB(w)
        [COLOR="Navy"]End[/COLOR] If
        c = c + 1
        nray(Rw, c) = Ray(n, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]If[/COLOR] n Mod 4 = 0 [COLOR="Navy"]Then[/COLOR]
        w = 0
        v = v + 6
        Rw = Rw + 2
    [COLOR="Navy"]Else[/COLOR]
        Rw = v
        w = w + 1
    [COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]Next[/COLOR] n
Range("R6").Resize(Rw, UBound(nray, 2)) = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this for results starting "R6".
Code: 
[COLOR=navy]Sub[/COLOR] MG28Jan46
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Rw [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, colsA [COLOR=navy]As[/COLOR] Variant, Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] ColsB [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] w [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] v [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]

Ray = Range("C6", Range("C" & Rows.Count).End(xlUp)).Resize(, 14)

ReDim nray(1 To UBound(Ray, 1) * 2, 1 To 20)
[COLOR=navy]For[/COLOR] n = 1 To UBound(Ray, 1)
    colsA = Array(1, 5, 9, 12, 20)
    ColsB = Array(0, 5, 10, 15)
    p = 0
    [COLOR=navy]For[/COLOR] Ac = 1 To 14
        [COLOR=navy]If[/COLOR] Ac = colsA(p) [COLOR=navy]Then[/COLOR]
            Rw = Rw + 1
            p = p + 1
            c = ColsB(w)
        [COLOR=navy]End[/COLOR] If
        c = c + 1
        nray(Rw, c) = Ray(n, Ac)
    [COLOR=navy]Next[/COLOR] Ac
    [COLOR=navy]If[/COLOR] n Mod 4 = 0 [COLOR=navy]Then[/COLOR]
        w = 0
        v = v + 6
        Rw = Rw + 2
    [COLOR=navy]Else[/COLOR]
        Rw = v
        w = w + 1
    [COLOR=navy]End[/COLOR] If

[COLOR=navy]Next[/COLOR] n
Range("R6").Resize(Rw, UBound(nray, 2)) = nray
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...
MickG, the example I posted causality have 44 rows so it works fine, when I add extra rows 1, 2 or 3 that do not copied until I do not add minimum 4, can this be solved please </SPAN></SPAN>

Thank you for your kind help</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti :)</SPAN></SPAN>
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG28Jan29
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, colsA [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ColsB [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] v [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

Ray = Range("C6", Range("C" & Rows.Count).End(xlUp)).Resize(, 14)

[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    colsA = Array(1, 5, 9, 12, 20)
    ColsB = Array(0, 5, 10, 15)
    p = 0
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 14
        [COLOR="Navy"]If[/COLOR] Ac = colsA(p) [COLOR="Navy"]Then[/COLOR]
            Rw = Rw + 1
            p = p + 1
            c = ColsB(w)
        [COLOR="Navy"]End[/COLOR] If
        c = c + 1
        Range("R6").Cells(Rw, c) = Ray(n, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]If[/COLOR] n Mod 4 = 0 [COLOR="Navy"]Then[/COLOR]
        w = 0
        v = v + 6
        Rw = Rw + 2
    [COLOR="Navy"]Else[/COLOR]
        Rw = v
        w = w + 1
    [COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG28Jan29
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Rw [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, colsA [COLOR=navy]As[/COLOR] Variant, Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] ColsB [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] w [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] v [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]

Ray = Range("C6", Range("C" & Rows.Count).End(xlUp)).Resize(, 14)

[COLOR=navy]For[/COLOR] n = 1 To UBound(Ray, 1)
    colsA = Array(1, 5, 9, 12, 20)
    ColsB = Array(0, 5, 10, 15)
    p = 0
    [COLOR=navy]For[/COLOR] Ac = 1 To 14
        [COLOR=navy]If[/COLOR] Ac = colsA(p) [COLOR=navy]Then[/COLOR]
            Rw = Rw + 1
            p = p + 1
            c = ColsB(w)
        [COLOR=navy]End[/COLOR] If
        c = c + 1
        Range("R6").Cells(Rw, c) = Ray(n, Ac)
    [COLOR=navy]Next[/COLOR] Ac
    [COLOR=navy]If[/COLOR] n Mod 4 = 0 [COLOR=navy]Then[/COLOR]
        w = 0
        v = v + 6
        Rw = Rw + 2
    [COLOR=navy]Else[/COLOR]
        Rw = v
        w = w + 1
    [COLOR=navy]End[/COLOR] If

[COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...
MickG, Cheers! It is working flawless! Solved!</SPAN></SPAN>

Thank you very much for your kind support</SPAN></SPAN>

Kind Regards</SPAN></SPAN>
Moti :-D</SPAN></SPAN>

 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Cell above is selected when i duplicate row
Replies
2
Views
362
ipbr21054
I
V
  • Solved
Average Function
Replies
8
Views
381
Peter_SSs
Peter_SSs
W
  • Question Question
Trying to learn how to loop code
Replies
1
Views
233
mumps
mumps
F
  • Question Question
VBA to copy and insert a row below only if a certain criteria is met
Replies
2
Views
218
feni1388
F
W
  • Question Question
Copy formula across 28 day dynamic shift calendar
Replies
4
Views
334
Wolfgang17
W

Forum statistics

Threads
1,223,893
Messages
6,175,242
Members
452,623
Latest member
russelllowellpercy

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top