Auto row insert as per required

[harinsh]

Hi Team,

I looking for below macro requirement and hope can help me with it.

I have two sheets, Sheet1 is containing number and sheet2 containing the data. In sheet 2 if you have three line items then macro should insert the rows and copy the same row data as per the number updated in sheet 1. This should repeat for all the number of line items.

Example.
In Sheet 1 - A1 cell value =12

In Sheet 2 - data below

A</SPAN>	B</SPAN>	C</SPAN>
DEFC</SPAN>	1221</SPAN>	Jacks</SPAN>
ERDE</SPAN>	1232</SPAN>	Lub</SPAN>
RIEK</SPAN>	1214</SPAN>	Cable</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>

Requirement - Macro should insert and copy the same A1 value in Sheet2 12 times and should repeat the same for rest of two line items. Please note that there should be additional empty row between each line item after inserting the rows.

Plz let me know if you need further clarificaiton on the above.

Thanks for your time.

 

[kevatarvind]

Pls upload desired result also

 

[harinsh]

This is output look like

A	B	C
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
DEFC	1221	Jacks
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
ERDE	1232	Lub
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable
RIEK	1214	Cable

<colgroup><col style="width:48pt" span="3" width="64"> </colgroup><tbody>
</tbody>

 

[kevatarvind]

try below code

Option Explicit
Sub Test()
Dim inrng As Long
Dim i As Integer
Dim lr As Long
inrng = Sheets("Sheet1").Range("A1").Value
Sheets("Sheet2").Select
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
Cells(i + 1, 1).Resize(inrng - 1, 1).EntireRow.Insert
Cells(i, 1).Resize(inrng, 3).FillDown
Next i
End Sub

 

[harinsh]

Super...its working fine...but I need little customise when you count the number of rows in Sheet 2 it always should exclude begining for the two rows....that A1 & A2 rows and starts from A3.

One more thing I need to include one empty row in between each set of rows. Like once it's filldown 12 rows then there should be one empty row then again start the second one.

Thanks for your time and efforts....

 

[kevatarvind]

try below code

Option Explicit
Sub Test()
Dim inrng As Long
Dim i As Integer
Dim lr As Long
inrng = Sheets("Sheet1").Range("A1").Value
Sheets("Sheet2").Select
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = lr To 3 Step -1
Cells(i + 1, 1).Resize(inrng, 1).EntireRow.Insert
Cells(i, 1).Resize(inrng, 3).FillDown
Next i
Rows(3).EntireRow.Insert
End Sub

 

[harinsh]

Thank you very much