A little macro help?

  • Thread starter Thread starter Alan
  • Start date Start date
A

Alan

I would like to use a macro to copy and repeat lines 'X' times on a new
page. To find out how many times each row is to be copied, the number is
provided in the last column ('C' in this case) of a spreadsheet.
Sample data for start point:

Lastname First Name Qty
Smith John 3
Hank Aaron 5


Result required on new sheet in same spreadsheet:

Lastname First Name
Smith John
Smith John
Smith John
Hank Aaron
Hank Aaron
Hank Aaron
Hank Aaron
Hank Aaron



Can someone provide some macro code that will create the number of
required rows on a new sheet called 'list' within the same spreadsheet?

TIA, Alan
 
Alan,

Sub CopyRecords()
Dim i As Long
Dim SourceRow As Long, DestRow As Long
SourceRow = 2 ' starting row
DestRow = 2 ' destination row
Do While Cells(SourceRow, 1) <> ""
For i = 1 To Cells(SourceRow, 3)
ActiveSheet.Cells(SourceRow, 1).Resize(1, 2).Copy
Destination:=Sheets("List").Cells(DestRow, 1)
DestRow = DestRow + 1
Next i
SourceRow = SourceRow + 1
Loop
End Sub

The source sheet must be the active sheet.
 
Earl Kiosterud wrote:
Many thanks Earl, it's working for me.
One more question if I may...
If the sheet "list" doesn't exist, how can I add the sheet "list"? The
command Sheets.add doesn't accept the name list. I also can't assume
that the next sheet added is going to be called "sheet1". Any ideas?

Thx, Alan
 
Alan,

Sub CopyRecords()
Dim i As Long
Dim SourceRow As Long, DestRow As Long
Dim Wks As Worksheet
Dim HaveSheetList As Boolean
SourceRow = 2 ' starting row
DestRow = 2 ' destination row

For Each Wks In ActiveWorkbook.Sheets ' search for sheet named "List"
If Wks.Name = "List" Then ' found one
HaveSheetList = True ' set flag
Exit For ' get out
End If
Next Wks
If Not HaveSheetList Then ' don't have "List"
Sheets.Add ' add it
ActiveSheet.Name = "List" ' name it
End If

Do While Sheets("Master").Cells(SourceRow, 1) <> ""
For i = 1 To Sheets("Master").Cells(SourceRow, 3)
Sheets("Master").Cells(SourceRow, 1).Resize(1, 2).Copy
Destination:=Sheets("List").Cells(DestRow, 1)
DestRow = DestRow + 1
Next i
SourceRow = SourceRow + 1
Loop
End Sub

The source sheet is called "Master" now. You can change occurences of
Sheets("Master") to reflect the name of your source sheet. Note that this
will start copying records to row 2 even if "List" already exists and has
stuff in it.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top