Copy selected column data and paste into another sheet.

[motilulla]

Using Excel 2010

Hello,

In the “sheet data” from column “C to Column P” I have header “n1 to n14” Out of 14 columns I want to select any 10 columns and copy them into the sheet “Copy 10 Columns” in the range C5:L5 below including one row header…

For example in the “sheet data” if I select by mouse cell C5, D5, F5, H5, J5, K5, L5, N5, O5, P5 (10 COLUMNS) Is it possible all column data till row 40 can be copied and paste in to sheet “Copy 10 Columns” in the range C5:L5 below including one row header…

Please see the example data… request need VBA solution.

Trails.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	YEAR	Seriol Num	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	EM1	Sum
2	YEAR	Seriol Num	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	EM1	Sum
3	YEAR	Seriol Num	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	EM1	Sum
4	YEAR	Seriol Num	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	EM1	Sum
5	YEAR	Seriol Num	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	EM1	Sum
6	2006	1	160	199	78	28	42	72	7	85	17	118	18	199	177	150		1350
7	2006	2	43	186	128	97	145	29	74	152	130	188	58	185	170	105		1690
8	2006	3	18	22	95	51	78	127	137	50	132	164	84	99	49	73		1179
9	2006	4	27	135	170	100	39	115	49	49	111	54	42	131	161	60		1243
10	2006	5	23	165	161	25	59	60	167	172	47	146	160	12	177	95		1469
11	2006	6	152	198	64	141	4	21	60	190	48	186	109	153	37	17		1380
12	2006	7	171	116	88	156	156	200	60	105	136	185	7	73	197	87		1737
13	2006	8	158	36	39	54	55	74	23	88	92	139	124	1	193	168		1244
14	2006	9	107	8	93	116	177	104	121	123	168	98	194	86	197	76		1668
15	2007	10	139	78	183	60	11	178	190	64	81	147	84	77	25	157		1474
16	2007	11	75	94	91	16	125	149	106	10	2	140	74	5	104	154		1145
17	2007	12	91	95	100	56	23	116	174	108	38	104	149	4	78	95		1231
18	2007	13	13	109	105	31	66	12	139	52	154	71	192	164	106	39		1253
19	2007	14	105	188	81	144	174	80	11	95	174	50	188	68	163	23		1544
20	2007	15	2	40	174	21	92	61	192	43	196	147	107	4	39	78		1196
21	2007	16	39	66	183	39	59	126	124	52	22	64	50	82	89	19		1014
22	2007	17	75	90	112	116	181	196	35	122	9	166	148	25	167	153		1595
23	2007	18	146	166	131	160	137	193	170	195	124	19	60	100	41	79		1721
24	2007	19	45	57	8	122	51	58	124	147	73	147	192	129	93	67		1313
25	2007	20	146	20	26	14	40	158	167	101	193	155	193	29	182	97		1521
26	2007	21	129	2	86	56	123	164	164	159	72	27	49	62	40	88		1221
27	2007	22	36	69	143	124	177	102	25	20	179	183	33	170	55	136		1452
28	2007	23	179	80	119	150	121	82	134	62	149	9	94	79	124	160		1542
29	2008	24	18	133	129	100	178	81	69	23	50	113	17	97	178	184		1370
30	2008	25	20	77	37	53	169	102	69	185	59	170	106	127	153	183		1510
31	2008	26	96	194	102	146	104	105	113	190	164	37	155	76	35	7		1524
32	2008	27	85	108	79	5	17	161	69	7	145	66	80	67	48	167		1104
33	2008	28	146	106	24	126	32	54	186	75	56	82	105	10	129	200		1331
34	2008	29	27	54	125	124	110	30	78	54	133	35	187	147	125	26		1255
35	2008	30	119	184	35	22	196	181	94	50	62	145	19	76	16	107		1306
36	2008	31	56	195	78	121	161	45	56	55	3	185	128	68	85	145		1381
37	2008	32	155	105	180	53	197	120	114	132	97	200	135	144	157	81		1870
38	2008	33	126	14	177	80	133	133	84	75	32	157	73	107	107	82		1380
39	2008	34	147	58	4	164	5	162	149	142	34	103	102	179	33	196		1478
40	2009	35	147	164	79	120	69	159	37	79	126	34	95	90	4	8		1211
41	2009	36
42	2009	37
43	2009	38
44	2009	39
45	2009	40
46	2009	41
47	2010	42
Data

Expected Result...10 columns

Trails.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2
3
4
5	YEAR	Seriol Num	n1	n2	n4	n6	n8	n9	n10	n12	n13	n14	EM1	Sum
6	2006	1	160	199	28	72	85	17	118	199	177	150		1205
7	2006	2	43	186	97	29	152	130	188	185	170	105		1285
8	2006	3	18	22	51	127	50	132	164	99	49	73		785
9	2006	4	27	135	100	115	49	111	54	131	161	60		943
10	2006	5	23	165	25	60	172	47	146	12	177	95		922
11	2006	6	152	198	141	21	190	48	186	153	37	17		1143
12	2006	7	171	116	156	200	105	136	185	73	197	87		1426
13	2006	8	158	36	54	74	88	92	139	1	193	168		1003
14	2006	9	107	8	116	104	123	168	98	86	197	76		1083
15	2007	10	139	78	60	178	64	81	147	77	25	157		1006
16	2007	11	75	94	16	149	10	2	140	5	104	154		749
17	2007	12	91	95	56	116	108	38	104	4	78	95		785
18	2007	13	13	109	31	12	52	154	71	164	106	39		751
19	2007	14	105	188	144	80	95	174	50	68	163	23		1090
20	2007	15	2	40	21	61	43	196	147	4	39	78		631
21	2007	16	39	66	39	126	52	22	64	82	89	19		598
22	2007	17	75	90	116	196	122	9	166	25	167	153		1119
23	2007	18	146	166	160	193	195	124	19	100	41	79		1223
24	2007	19	45	57	122	58	147	73	147	129	93	67		938
25	2007	20	146	20	14	158	101	193	155	29	182	97		1095
26	2007	21	129	2	56	164	159	72	27	62	40	88		799
27	2007	22	36	69	124	102	20	179	183	170	55	136		1074
28	2007	23	179	80	150	82	62	149	9	79	124	160		1074
29	2008	24	18	133	100	81	23	50	113	97	178	184		977
30	2008	25	20	77	53	102	185	59	170	127	153	183		1129
31	2008	26	96	194	146	105	190	164	37	76	35	7		1050
32	2008	27	85	108	5	161	7	145	66	67	48	167		859
33	2008	28	146	106	126	54	75	56	82	10	129	200		984
34	2008	29	27	54	124	30	54	133	35	147	125	26		755
35	2008	30	119	184	22	181	50	62	145	76	16	107		962
36	2008	31	56	195	121	45	55	3	185	68	85	145		958
37	2008	32	155	105	53	120	132	97	200	144	157	81		1244
38	2008	33	126	14	80	133	75	32	157	107	107	82		913
39	2008	34	147	58	164	162	142	34	103	179	33	196		1218
40	2009	35	147	164	120	159	79	126	34	90	4	8		931
41	2009	36
42	2009	37
43	2009	38
44	2009	39
45	2009	40
Copy 10 Columns

Regards,
Moti

 

[jolivanes]

A quick one as I am on the way to do other things.
Adapt as required by changing references. If it does not do what you need after adjusting, come back and let us know.

Sub Maybe_So()
Dim c As Range, rng As Range
    For Each c In Selection
        If rng Is Nothing Then
            Set rng = c.Resize(35)    '<---- ?????
                Else
            Set rng = Union(rng, c.Resize(35))    '<---- ?????
        End If
    Next c
rng.Copy Sheets("Sheet2").Cells(5, 3)    '<---- Change sheet name and cell address
End Sub

 

[motilulla]

A quick one as I am on the way to do other things.
Adapt as required by changing references. If it does not do what you need after adjusting, come back and let us know.

Sub Maybe_So()
Dim c As Range, rng As Range
    For Each c In Selection
        If rng Is Nothing Then
            Set rng = c.Resize(35)    '<---- ?????
                Else
            Set rng = Union(rng, c.Resize(35))    '<---- ?????
        End If
    Next c
rng.Copy Sheets("Sheet2").Cells(5, 3)    '<---- Change sheet name and cell address
End Sub

Hello jolivanes, yes code worked perfect as requested. I could modified the “IngLastRow” range from column “C” here below the code is attached.

Please I need further help instead of paste all. Is it possible to paste only the values?

I appreciate your support.

Sub Maybe_So()

    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row - 4
 
    Dim c As Range, rng As Range
    For Each c In Selection
        If rng Is Nothing Then
            Set rng = c.Resize(lngLastRow)    '<---- ?????
                Else
            Set rng = Union(rng, c.Resize(lngLastRow))    '<---- ?????
        End If
    Next c
 
    rng.copy Sheets("Sheet2").Cells(5, 3)   '<---- Change sheet name and cell address
 
 
End Sub

Kind Regards,
Moti

 

[motilulla]

Hello jolivanes, Please I need further help instead of paste all. Is it possible to paste only the values?

Kind Regards,
Moti

Hello Jolivanes, finally also I could manage to paste values only. Please can you check the code if there is any error make it correct. Thank you.
Have a nice day good luck.

Sub Maybe_So()

    Sheets("Sheet2").Range("C5:M5006").ClearContents
  
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row - 4
  
    Dim c As Range, rng As Range
    For Each c In Selection
        If rng Is Nothing Then
            Set rng = c.Resize(lngLastRow)    'Set Last Range
                Else
            Set rng = Union(rng, c.Resize(lngLastRow))    'Set Union Last Range
        End If
    Next c
  
    rng.copy
    Sheets("Sheet2").Range("C5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C6").Select
  
End Sub

Kind Regards,
Moti