MACRO NEEDED

[PM1]

Purch Orders BP²I.xls
	A	B	C	D	E	F	G	H	I	J	K
1	PS PO No	Line No	Company	Part No	Details	Qty	Unit Cost (GBP)	Expense / Asset	Asset Value	GLCode	GL Description
2	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
3	8	1	Repton	325134-421	ProLiant DL580 (G2) R02 Xeon	1	6,365.00	9	6,365	241370	Windows NT Servers
Steve

Is there a way to run a Macro that goes to "F6", then If the No. > 1 copies the row and inserts it by the No. in "F6" - 1, therefore in this instance 5 rows identical 2 Row 2 would be copied, and so on till the end of the column.

So the sheet would look like:

Purch Orders BP²I.xls
	A	B	C	D	E	F	G	H	I	J	K
1	PS PO No	Line No	Company	Part No	Details	Qty	Unit Cost (GBP)	Expense / Asset	Asset Value	GLCode	GL Description
2	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
3	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
4	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
5	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
6	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
7	4	1	Repton	292889-421	ProLiant DL360 (G3) R02 Xeon DP 2.8GHz, 512MB	6	1,266.00	9	1,266	241370	Windows NT Servers
8	8	1	Repton	325134-421	ProLiant DL580 (G2) R02 Xeon	1	6,365.00	9	6,365	241370	Windows NT Servers
9	9	6	NetApps	FAS960C-IB-BASE	2 FAS960, CFO, IB, DATA ONTAP	1	38,960.64	9	38,961	241400	Networks
10	13	1	Repton	7038-6M2	Rack Server 1:pSeries 650 Model 6M2 CEC	4	2,753.25	9	2,753	653120B	IBM Servers
Steve

 

[Rahadian]

Try this code:

Sub Macro1()
Dim Nrow, Qty
Nrow = 1
Do
Nrow = Nrow + 1
Qty = Cells(Nrow, 6).Value
If Qty > 1 Then
Rows(Nrow + 1 & ":" & Nrow + Qty - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Range(Cells(Nrow, 1), Cells(Nrow, 11)).Copy
Range(Cells(Nrow + 1, 1), Cells(Nrow + Qty - 1, 1)).PasteSpecial
Nrow = Nrow + Qty - 1
End If
Loop Until Qty = ""
End Sub

 

[PM1]

WOW
What can I say, works a treat.

MANY THANKS