#1   Report Post  
Alan
 
Posts: n/a
Default A little macro help?

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
  #2   Report Post  
Earl Kiosterud
 
Posts: n/a
Default

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
mvpearl omitthisword at verizon period net
-------------------------------------------

"Alan" wrote in message
42...
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



  #3   Report Post  
Alan
 
Posts: n/a
Default

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
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.


  #4   Report Post  
Earl Kiosterud
 
Posts: n/a
Default

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.
--
Earl Kiosterud
mvpearl omitthisword at verizon period net
-------------------------------------------

"Alan" wrote in message
...
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
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.




  #5   Report Post  
Alan
 
Posts: n/a
Default

Works great! Thanks so much for your help!

Alan








Earl Kiosterud wrote:

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.


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Date macro Hiking Excel Discussion (Misc queries) 9 February 3rd 05 12:40 AM
Can't get simple macro to run Abi Excel Worksheet Functions 5 January 12th 05 07:37 PM
Help with macro formula and variable Huge project Excel Worksheet Functions 0 December 28th 04 01:27 AM
Macro and If Statement SATB Excel Discussion (Misc queries) 2 December 3rd 04 04:46 PM
Macro Formula revision? Mark Excel Worksheet Functions 1 November 28th 04 01:43 AM


All times are GMT +1. The time now is 01:33 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"