Macro that shifts data to new columns based on row limits

[rwmill9716]

I need a macro that will: (1) copies Columns C and E (from row 8 on) to Columns G and H, (2) reads shift limits in Cells F5 and G5, (3), copies data in Columns E and F, (4) writes that data in Columns G and H between the shift limits.

Excel 2012
	C	D	E	F	G	H
4				Shift Data to Row	End Shift	56.5
5				12	16	55.5
6					Ppk =	#DIV/0!
7	Date/Time	List 1	Date/Time	List 2	Date	Composite
8	01/01/16	1	01/05/16	100	01/01/16	1
9	01/02/16	2	01/06/16	101	01/02/16	2
10	01/02/16	3	01/07/16	102	01/02/16	3
11	01/04/16	4	01/08/16	103	01/04/16	4
12	01/05/16	5	01/09/16	104	01/05/16	100
13	01/06/16	6			01/06/16	101
14	01/08/16	7			01/07/16	102
15	01/09/16	8			01/08/16	103
16	01/10/16	9			01/09/16	104
17	01/10/16	10			01/10/16	10
18	01/11/16	11			01/11/16	11
19	01/12/16	12			01/12/16	12
20	01/13/16	13			01/13/16	13
21	01/14/16	14			01/14/16	14
22	01/15/16	15			01/15/16	15
23	01/17/16	16			01/17/16	16
24	01/17/16	17			01/17/16	17
25	01/18/16	18			01/18/16	18
26	01/19/16	19			01/19/16	19
27	01/21/16	20			01/21/16	20
28	01/21/16	21			01/21/16	21
Sheet4

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG08Dec26
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("C" & [g5] + 1, Range("C" & Rows.Count).End(xlUp))
Range("C8:C" & [f5] - 1).Resize(, 2).Copy Cells(8, "G")
Range("E8:E" & [f5]).Resize(, 2).Copy Cells([f5], "G")
Rng.Resize(, 2).Copy Cells([g5] + 1, "G")
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[rwmill9716]

Thanks, Mick, this code works well.

Ric

 

[rwmill9716]

Mick,

I ran into a problem that I didn't expect and wonder if there's an easy fix. All the data in Columns C, D, E and F are array members. I need the data pasted into columns G and H to be without the array formula, just the dates and numbers. I know that I can do this with a normal cut and paste operation.

Thanks,

Ric

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG09Dec17
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("C" & [g5] + 1, Range("C" & Rows.Count).End(xlUp))
Range("C8:C" & [f5] - 1).Resize(, 2).Copy
    Cells(8, "G").PasteSpecial Paste:=xlPasteValues
Range("E8:E" & [f5]).Resize(, 2).Copy
    Cells([f5], "G").PasteSpecial Paste:=xlPasteValues
Rng.Resize(, 2).Copy
    Cells([g5] + 1, "G").PasteSpecial Paste:=xlPasteValues
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick