VBA elusive copy multiple rows as per given data in column G

[Kishan]

Using Excel 2000

Hi,

VBA that copy as per number of row mention in cells G6:G15 from a columns C, D, E and paste in to as explain continuation....
If rows to be copied start with 1 than to be past in column I, J, & K
If rows to be copied start with X than to be past in column M, N, & O
If rows to be copied start with 2 than to be past in column Q, R, & S

For example:
G6=3 copy 3 rows C6:E8 as start of the copy row C6=X this paste in to M6:O8
G7=6 copy 6 rows C9:E14 as start of the copy row C9=X this paste in to M9:O14
G8=6 copy 6 rows C15:E20 as start of the copy row C15=1 this paste in to I6:K11
G9=5 copy 5 rows C21:E25 as start of the copy row C21=2 this paste in to Q6:S10
And so on...

Example data

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1
2
3
4
5			C1	C2	C3		Data			1				X				2
6			X	S	X		3		1	S	1		X	S	X		2	S	X
7			2				6		X				2				1
8			1	3	1		6		1				1	3	1		1
9			X	S	X		5		X				X	S	X		1
10			1				12		1				1				X	5	2
11			X				3		2	6	2		X				2	S	2
12			1				6		1	S	1		1				1
13			1				11		1				1				1
14			2	6	2		6		1				2	6	2		1
15			1	S	1		17		1				X	S	X		1
16			X						1				1				X	6	X
17			1						1				2	3	2		2	S	2
18			X						1								1
19			1						1								2
20			2	6	2				2								1
21			2	S	X				2								1
22			1						1								X	6	X
23			1						X	12	X
24			1						1	S	1
25			X	5	2				2
26			1	S	1				1
27			1						1
28			1						2
29			1						1
30			1						1
31			1						1
32			1						1
33			1						1
34			2						X	11	X
35			2						1	S	1
36			1						2
37			X	12	X				2
38			X	S	X				2
39			1						2
40			2	3	2				2
41			2	S	2				1
42			1						1
43			1						2
44			1						2
45			1						1
46			X	6	X				1
47			1	S	1				2
48			2						2
49			1						1
50			1						1
51			2						X	17	X
52			1
53			1
54			1
55			1
56			1
57			X	11	X
58			2	S	2
59			1
60			2
61			1
62			1
63			X	6	X
64			1	S	1
65			2
66			2
67			2
68			2
69			2
70			1
71			1
72			2
73			2
74			1
75			1
76			2
77			2
78			1
79			1
80			X	17	X
81			1	S	1
82			X
83
84
85
86
87
Sheet2

Thank you in advance

Regards
Kishan

 

[Leith Ross]

Hello Kishan,

Will column "G" be used by the macro to determine the number of rows in columns "C:E" to be copied?

 

[Kishan]

Hello Kishan,

Will column "G" be used by the macro to determine the number of rows in columns "C:E" to be copied?

Thank you Leith Ross, yes column "G" is filled to determine the number of rows to be copied in columns "C:E" so far yes column "G" can be used in the macro no problem.

Regards,
Kishan

 

[Kishan]

Bump

 

[JackDanIce]

Try:

Sub CopyMove()

    Dim arr()   As Variant
    Dim temp()  As Variant
    Dim x       As Long
    Dim r       As Long
    Dim c       As Long
    
    x = Cells(Rows.count, 7).End(xlUp).row - 5
    r = 6
    arr = Cells(6, 7).Resize(x).Value
    
    Application.ScreenUpdating = False
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        temp = Cells(r, 3).Resize(arr(x, 1), 3).Value
        Select Case UCase(Cells(r, 3).Value)
            Case Is = 1: c = 10
            Case Is = "X": c = 14
            Case Is = 2: c = 18
        End Select
        Cells(Rows.count, c).End(xlUp).Offset(1, -1).Resize(UBound(temp, 1), UBound(temp, 2)).Value = temp
        Erase temp
        r = r + arr(x, 1)
    Next x
    
    Application.ScreenUpdating = True
    
    Erase arr
    
End Sub

 

[Kishan]

Try:

Sub CopyMove()

    Dim arr()   As Variant
    Dim temp()  As Variant
    Dim x       As Long
    Dim r       As Long
    Dim c       As Long
    
    x = Cells(Rows.count, 7).End(xlUp).row - 5
    r = 6
    arr = Cells(6, 7).Resize(x).Value
    
    Application.ScreenUpdating = False
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        temp = Cells(r, 3).Resize(arr(x, 1), 3).Value
        Select Case UCase(Cells(r, 3).Value)
            Case Is = 1: c = 10
            Case Is = "X": c = 14
            Case Is = 2: c = 18
        End Select
        Cells(Rows.count, c).End(xlUp).Offset(1, -1).Resize(UBound(temp, 1), UBound(temp, 2)).Value = temp
        Erase temp
        r = r + arr(x, 1)
    Next x
    
    Application.ScreenUpdating = True
    
    Erase arr
    
End Sub

Hi JackDanIce,

Awesome! I copied the code and placed it in a new module. It just worked smoothly! At first instance.

Thank you so much for your help.

Kind Regards,
Kishan

 

[JackDanIce]

You're welcome

 

[Kishan]

Hi JackDanIce, Because of my old excel version this has only 256 columns for the coverage of all results I need more columns.

For that reason please could you modify the macro so results can be copied in to the sheet1, starting from column C6

Sorry for the trouble again

Thank you

Kind Regards,
Kishan

 

[JackDanIce]

I do not understand, your data is across 3 columns, C:E.

You have three values to consider, 1, X and 2

Your ask is to take the data in column C and distribute it across 3 columns I:K, M:O and Q:S

That suggests you only need 3 * 4 columns maximum i.e. 12

Where are the results being copied from? Do you mean the data being copied into C6 has more than 3 columns?

 

[Kishan]

I do not understand, your data is across 3 columns, C:E.

You have three values to consider, 1, X and 2

Hi JackDanIce,

Actual data are in 5 columns C:G this is one set of data. I have total 20 sets

Adding 1 free space within each set data start from "C" and 20 set end in column "DQ" which is column 121, I modified the macro to get first set column C:G data result, in the columns DS:EC using 11 columns (column DR left empty in-between the last set and 1st result) after when I was preparing a sheet to get a result for all 20 of sets I found that 11th set were using column II:IS, IS which is column 253 left only 3 at the end column

So thought if I leave the sets of 20 data in the "sheet Data" and gets result of CopyMove in "sheet1" from column C that will end in column IG (within column 3 to 241) getting all result for 20 sets which will be handy instead of dividing the data in 2 sheets could be the solution

That's why I request you if the data result could be copied in "sheet1" would be easy for me to have data in the "sheet Data" and results in an another "sheet1".

My request please is it possible to modified the macro and get the result in sheet1

Thank you

Kind Regards,
Kishan