Duplicate lines based on qty in cell 1

[Aerowolf]

I have a list of ship-to addresses from a customer. The last field contains the number of packages to ship to each location.
In order to import this into my Fedex software, I need to have each line represent one package. Therefore, I need to duplicate each line in the original list by the number of packages that location is getting.

i.e. first line gets 10 pkgs. I now need to have 10 lines at 1 package each...and so on for the entire list.

Is there an easy way to do this (maybe a little piece of code) without copying and inserting manually?

Thanks

Edwin

 

[xlhelp]

The following macro takes info from sheet1 and pastes it into sheet2.

line
N = Range("E" & R).Value
defines where your package count is; in this case column E


Line
Range(Cells(R, 1), Cells(R, 4)).Select
defines where your Fedex info is; in this case columns A (1) through D (4)


Public Sub copy()

Dim R As Long
Dim C As Range
Dim N As Long
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

For R = 2 To Rng.Rows.Count
N = Range("E" & R).Value
Range(Cells(R, 1), Cells(R, 4)).Select
Selection.Copy
Sheets("Sheet2").Activate
For S = 1 To N
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next S
Sheets("Sheet1").Activate
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Credit:Modified a macro written by Chip Pearson

http://www.geniusmedia.ca

 

[Aerowolf]

Thank you for this.

Works great except that it only processes the first line. How do I make it do the whole sheet?

Edwin

 

[xlhelp]

I had 4 lines that it processed to produce about 27 lines.

Hopefully you don't have any blank rows. Did you change only the 2 lines that I indicated?

BTW, it starts processing at row2 & starts producing data at row2 as well

http://www.geniusmedia.ca

 

[Aerowolf]

Got it to work and it works great!!!

Thanks alot!

Edwin