Copy paste only selected columns to another locations

[motilulla]

Hello,</SPAN></SPAN>

I got lottery results in the cells C6:J1000, I want to copy few columns as per my prior selection, for example I want to be coped only those column which I selected marking "X" in the cells C4:J4 in the example there are 5 selected out of 8 which I need to be copied and pasted from the column "M" to next columns all data as long as find in columns C6:J6 to end rows </SPAN></SPAN>

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3
4			X		X	X			X	X
5			Numbers	n1	n2	n3	n4	n5	*1	*2			Numbers	n2	n3	*1	*2
6			1	36	10	6	39	31	6	10			1	10	6	6	10
7			2	35	33	26	40	5	3	8			2	33	26	3	8
8			1	2	10	30	44	1	1	8			1	10	30	1	8
9			4	43	38	19	10	46	1	11			4	38	19	1	11
10			5	2	30	38	43	46	7	2			5	30	38	7	2
11			8	27	10	30	47	12	9	8			8	10	30	9	8
12			10	15	40	24	48	38	2	9			10	40	24	2	9
13			12	29	32	23	1	5	1	7			12	32	23	1	7
14			1	36	21	10	6	9	6	2			1	21	10	6	2
15			7	46	32	27	3	41	4	8			7	32	27	4	8
16			7	9	6	13	28	37	4	5			7	6	13	4	5
17			7	31	49	28	20	3	5	2			7	49	28	5	2
18			5	3	22	50	10	37	6	10			5	22	50	6	10
19			5	32		14	39	30	3	9			5		14	3	9
20			5	42		23	25	37	11	1			5		23	11	1
21			9	13		5	33	15	9	11			9		5	9	11
22			8	37		28	13	4	11	10			8		28	11	10
23			5	9		40	16	14	1	5			5		40	1	5
24			4	9		23	8	1	7	1			4		23	7	1
25			3	26		1	21	40		6			3		1		6
26			2	7		5	44	34		2			2		5		2
27			2	14		21	19	24		11			2		21		11
28			2	15		12	26	42		8			2		12		8
29			2	43		12	42	19		5			2		12		5
30			2	4		19	36	1		11			2		19		11
Sheet3

Thank you all</SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN>
Moti</SPAN>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG19Jul52
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay [COLOR="Navy"]As[/COLOR] Variant, Rng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("C5:J30")
[COLOR="Navy"]Set[/COLOR] Rng = Range("C4:J4")
[COLOR="Navy"]For[/COLOR] n = 1 To Rng.Count
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(Rng(n).Value) [COLOR="Navy"]Then[/COLOR]
        Num = Num & IIf(Num = "", n, "," & n)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n

nRay = Application.Index(Ray, Evaluate("Row(1:" & UBound(Ray, 1) & ")"), Split(Num, ","))
Range("M5").Resize(UBound(Ray, 1), UBound(Split(Num, ",")) + 1) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[motilulla]

Try this:-

[COLOR=navy]Sub[/COLOR] MG19Jul52
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, nRay [COLOR=navy]As[/COLOR] Variant, Rng [COLOR=navy]As[/COLOR] Range, R [COLOR=navy]As[/COLOR] Range, Num [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Ray = Range("C5:J30")
[COLOR=navy]Set[/COLOR] Rng = Range("C4:J4")
[COLOR=navy]For[/COLOR] n = 1 To Rng.Count
    [COLOR=navy]If[/COLOR] Not IsEmpty(Rng(n).Value) [COLOR=navy]Then[/COLOR]
        Num = Num & IIf(Num = "", n, "," & n)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n

nRay = Application.Index(Ray, Evaluate("Row(1:" & UBound(Ray, 1) & ")"), Split(Num, ","))
Range("M5").Resize(UBound(Ray, 1), UBound(Split(Num, ",")) + 1) = nRay
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Mick, macro result excellent it copies header too, which I did, not thought before it is solved 100% ok.</SPAN></SPAN>

I appreciate your kind help </SPAN></SPAN>

Have a good day</SPAN></SPAN>

Kind Regards,</SPAN>
Moti </SPAN></SPAN>

 

[MickG]

You're welcome
Another option gives you your formatting if required !!!

[COLOR="Navy"]Sub[/COLOR] MG19Jul24
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay [COLOR="Navy"]As[/COLOR] Variant, Rng [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ac = 9
[COLOR="Navy"]Set[/COLOR] Rng = Range("C4:J4")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not IsEmpty(R) [COLOR="Navy"]Then[/COLOR]
        Ac = Ac + 1
        R.Offset(1).Resize(30).Copy Rng(1).Offset(1, Ac)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[motilulla]

You're welcome
Another option gives you your formatting if required !!!

[COLOR=navy]Sub[/COLOR] MG19Jul24
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, nRay [COLOR=navy]As[/COLOR] Variant, Rng [COLOR=navy]As[/COLOR] Range, R [COLOR=navy]As[/COLOR] Range, Num [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Ac = 9
[COLOR=navy]Set[/COLOR] Rng = Range("C4:J4")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not IsEmpty(R) [COLOR=navy]Then[/COLOR]
        Ac = Ac + 1
        R.Offset(1).Resize(30).Copy Rng(1).Offset(1, Ac)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] R
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Mick, this option is too good is coping and pasting every column and header fonts, background colours of cell fills as it is. Wow!</SPAN></SPAN>

Thank you so much for this alteration. </SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[MickG]

You're welcome