Rearrange the data in excel

[Apple Ang]

Hi,

This might easy, but I really need help from you all. I'm a beginner, & I hope I can learn VBA through this board. I problem as below.

I've a data which originally shown as below:

Book4
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Customer	CustomerIndex	PartNumber	Vendor	Status	ProposedPartNumber	ProposedVendor	Status	ProposedPartNumber	ProposedVendor	Status	ProposedPartNumber	ProposedVendor	Status
2	ABC	ABC-0001	223-0001	3M	Ori	M0009	5M	Alt	A101-2221	MOL	Alt	747-B01	ITT	Alt
3	IDA	IDA-010	C0603ZG	AVX	Ori	GRM188JR	Mura	Alt	2238-5654	Yag	Alt
Sheet1

I would like to hv a macro which will help me to rearrange the data to below format. The data for column start from F will be copy to another row but the data in column A & B will remain the same with that particular row. I can do it manually but I might kill me if I've more than 100 rows.

Book4
	A	B	C	D	E
13	Customer	CustomerIndex	PartNumber	Vendor	Status
14	ABC	ABC-0001	223-0001	3M	Ori
15	ABC	ABC-0001	M0009	5M	Alt
16	ABC	ABC-0001	A101-2221	MOL	Alt
17	ABC	ABC-0001	747-B01	ITT	Alt
18	IDA	IDA-010	C0603ZG	AVX	Ori
19	IDA	IDA-010	GRM188JR	Mura	Alt
20	IDA	IDA-010	2238-5654	Yag	Alt
Sheet1

Can somebody help me on this? Your help much appreciated.

Thanks & warm regards,
Apple

 

[PeregrinTook]

Hi Apple,

How about this:

Sub Rearrange()

For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 'start at the bottom row upwards 1 at a time until row 2
    For j = Range("IV" & i).End(xlToLeft).Column To 8 Step -3 'then at the furthest right col moving left 3 at a time until col 8
        Rows(i + 1).Insert 'insert a row immediately below current one
        Range(Cells(i, "A"), Cells(i, "B")).Copy Cells(i + 1, "A") 'copy current Cust & Index to col A:B in row below
        Range(Cells(i, j - 2), Cells(i, j)).Cut Cells(i + 1, "C") 'copy current PartNo, Vendor & Status to col C:E in row below
    Next j 'move left to the next set until you hit column 8
Next i 'move up to the next row until you hit row 2

Range("F1:N1").Clear 'delete excess titles

End Sub

All the best
PeregrinTook

 

[Apple Ang]

Hi PeregrinTook,

Thanks a lot for your great help. This is what I'm looking for. Really help me a lot.

Agains, thanks.

Warmest regards,
Apple