Adding rows and inserting data

[flyboy222]

I am trying to set up the sheet to do the following.

Take Qty. from column A insert that Qty of rows on a seperate sheet. Then take the product ID from Column B and insert it in every row inserted. How is this accomplished? Any help would be appreciated. It needs to be able to take this from a total of about 1000 rows and transfer to the other sheet. Not all rows will have a qty and will therefore hopefully be skipped.
HELP!
Eric

 

[John Davis]

Maybe:

Sub flyboy222()
Dim i As Long
Dim x As Long
Dim lr As Long
Dim ws As Worksheet

Set ws = ActiveSheet

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lr

    If Range("A" & i) <> "" Then

x = ws.Range("A" & i).Value

Sheets("Sheet2").Range("A" & Rows.Count).End(3)(2).EntireRow.Resize(x).Insert shift:=xlDown
ws.Range("B" & i).Copy Sheets("Sheet2").Range("B" & Rows.Count).End(3)(2).Resize(x)

End If

Next i


End Sub

 

[flyboy222]

This code works closely however from sheet one lets say I have 20 rows, when it runs to sheet to it starts 2 rows lower (like 22) How can I set the rows to start at the same cell every time on sheet 2. For example start adding the rows at A5. In this code it puts them in Col B on sheet 2.

 

[John Davis]

If I understand correctly,

Change:

ws.Range("B" & i).Copy Sheets("Sheet2").Range("B" & Rows.Count).End(3)(2).Resize(x)

To:

ws.Range("B" & i).Copy Sheets("Sheet2").Range("A5").Resize(x)

 

[flyboy222]

Thanks you this has been a great help one last question and the code may already accomplish this the if I want the code to ignore lets say the first five rows and lets say stop after for example row 100 what would I need to change.

 

[John Davis]

Change this:

For i = 2 To lr

To:

For i = 6 To 100

 

[flyboy222]

Okay I changed a couple of things (sheet2 to sheet 14 because that is the sheet I want the rows to be inserted on) but now it gives be the subscript out of range error here*****) WHAT DID I MESS UP? It should pull the data from sheet1 and put it on sheet14.
Sub Picksheet()
Dim i As Long
Dim x As Long
Dim lr As Long
Dim ws As Worksheet

Set ws = ActiveSheet

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = 14 To 1036

If Range("A" & i) <> "" Then

x = ws.Range("A" & i).Value

Sheets("Sheet14").Range("A" & Rows.Count).End(3)(2).EntireRow.Resize(x).Insert shift:=xlDown (*****)
ws.Range("B" & i).Copy Sheets("Sheet14").Range("A7").Resize(x)

End If

Next i

End Sub

 

[John Davis]

Which line is highlighted on the debugger? And what is this (*****) supposed to do?

 

[flyboy222]

The (*****) only refers to the highlighted line in the debugger
If you need I can email you the workbook.

 

[flyboy222]

When I tried this in a basic sheet from scratch this worked but when I try to adapt it to our database sheet it does not Again Subscript out of range at (*****) If you need me to email you the workbook I can.

Sub Picksheet()
Dim i As Long
Dim x As Long
Dim lr As Long
Dim ws As Worksheet

Set ws = ActiveSheet

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = 14 To 1036

If Range("A" & i) <> "" Then

x = ws.Range("A" & i).Value

Sheets("Sheet14").Range("A7").Resize(x).Insert shift:=xlDown (*****)
ws.Range("B" & i).Copy Sheets("Sheet14").Range("A7").Resize(x)

End If

Next i

End Sub