How to Copy & Paste Rows?

[none]

Please help with my lame attempt to have the user enter how many times a
row needs to be repeated. Here's the scenario: I have a
spreadsheet with weeks of the year for each year and need each one
repeated a certain number of times.


Sub SOCal()
'
' SOCal Macro

Range("G2").Select
StartVal = Val(InputBox("Enter how many lines per order: "))
Set currentCell = Worksheets("Sheet1").Range("G2")
Do While Not IsEmpty(currentCell)
For counter = 1 To (StartVal - 1)
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Paste
ActiveCell.Offset(1, 0).Select
Next counter
Loop

End Sub


Thanks for any help.

Mike

 

[none]

Please help with my lame attempt to have the user enter how many times a
row needs to be repeated. Here's the scenario: I have a spreadsheet
with weeks of the year for each year and need each one repeated a
certain number of times.


Sub SOCal()
'
' SOCal Macro

Range("G2").Select
StartVal = Val(InputBox("Enter how many lines per order: "))
Set currentCell = Worksheets("Sheet1").Range("G2")
Do While Not IsEmpty(currentCell)
For counter = 1 To (StartVal - 1)
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Paste
ActiveCell.Offset(1, 0).Select
Next counter
Loop

End Sub


Thanks for any help.

Mike

Here's the scenario: I have a spreadsheet with weeks of the year for
each row and need each one repeated a certain number of times.

 

[none]

Please help with my lame attempt to have the user enter how many times a
row needs to be repeated. Here's the scenario: I have a spreadsheet
with weeks of the year for each year and need each one repeated a
certain number of times.


Sub SOCal()
'
' SOCal Macro

Range("G2").Select
StartVal = Val(InputBox("Enter how many lines per order: "))
Set currentCell = Worksheets("Sheet1").Range("G2")
Do While Not IsEmpty(currentCell)
For counter = 1 To (StartVal - 1)
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Paste
ActiveCell.Offset(1, 0).Select
Next counter
Loop

End Sub


Thanks for any help.

Mike

Here's the scenario: I have a spreadsheet with weeks of the year for
each row and need each one repeated a certain number of times.

 

[Dave Peterson]

David McRitchie has some code you can steal.

He even shows how to copy the formulas, but clear out the constants.

http://www.mvps.org/dmcritchie/excel/insrtrow.htm
look for: #insrtrow

 

[Mike C]

David McRitchie has some code you can steal.

He even shows how to copy the formulas, but clear out the constants.

http://www.mvps.org/dmcritchie/excel/insrtrow.htm
look for: #insrtrow

Thanks for the help Dave!

I have a problem with my loop. It only copies the first row & pastes it
the correct number of times, but I need it to do the same for all the
rows in the spreadsheet.

Range("G2").Select
StartVal = Val(InputBox("Enter how many lines per order: "))
Do While Not IsEmpty(ActiveCell.Value)
For counter = 1 To (StartVal - 1)
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(1).EntireRow.PasteSpecial
Next counter
Loop
End Sub

Thanks,
Mike

 

[Dave Peterson]

So you're essentially repeating every row a set number of times?

Try this against a copy:

Option Explicit
Sub testme()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim HowMany As Long
Dim wks As Worksheet

HowMany = Application.InputBox("How many rows to insert?", Type:=1)

If HowMany = 0 _
Or HowMany > 100 Then
MsgBox "Please pick a nice number"
Exit Sub
End If

Set wks = ActiveSheet

With wks
FirstRow = 2 'stay away from headers???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(HowMany).EntireRow.Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(HowMany)
Next iRow
End With

End Sub

 

[Mike C]

So you're essentially repeating every row a set number of times?

Try this against a copy:

Option Explicit
Sub testme()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim HowMany As Long
Dim wks As Worksheet

HowMany = Application.InputBox("How many rows to insert?", Type:=1)

If HowMany = 0 _
Or HowMany > 100 Then
MsgBox "Please pick a nice number"
Exit Sub
End If

Set wks = ActiveSheet

With wks
FirstRow = 2 'stay away from headers???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(HowMany).EntireRow.Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(HowMany)
Next iRow
End With

End Sub

Awesome! Thanks a lot for your help.

Mike