Copy and insert rows and number of times

Solved/Closed
Pabs - Updated on Jan 1, 2019 at 10:04 AM
 Duck - Nov 18, 2014 at 01:20 PM
Hello,

I have a sheet with over 800 rows. I need to copy each row and insert/repeat each entry 4 times below the preceding row.

Example:

Before

name1
name2
name3


After

name1
name1
name1
name1
name2
name2
name2
name2
name3
name3
name3
name3

I'd appreciate it very much any help I can get with this.

Thank you.

System Configuration: Windows XP / Safari 534.3
Related:

8 responses

aquarelle Posts 7141 Registration date Saturday April 7, 2007 Status Moderator Last seen December 19, 2024 491
Updated on Jan 1, 2019 at 10:07 AM
Hi,

Look at this thread or try this macro:


Sub InsertRows()
Dim I As Long, J As Integer, Nb As Integer

For I = Range("A65536").End(xlUp).Row To 2 Step -1

Nb = 4

For J = 1 To Nb - 1
Rows(I + J).Insert xlDown
Rows(I).Copy
Rows(I + J).PasteSpecial '
Next

Next

Range("A1").Select
Application.CutCopyMode = False
End Sub



Best regards
Thank you for your response aquarelle. Unfortunately I was not able to find a satisfactory response in the link you provided. I'm not versed in Excel Macros so perhaps I'm missing some good information here.

Help please?

Thank you.
hey there its not my code but just use it

Sub Copy_Row()
'Written by Barrie Davidson
Dim NRow As Integer
Dim CurrentRow As Integer
Dim SheetName As String
Dim Datasheet As String

Datasheet = ActiveSheet.Name
ActiveWorkbook.Sheets.Add after:=Sheets(Datasheet)
SheetName = ActiveSheet.Name
Sheets(Datasheet).Select
Range("A1").Select
Do Until Selection.Value = ""
CurrentRow = Selection.Row
NRow = InputBox("Current row selected is " & CurrentRow & Chr(13) & _
"Enter Number of Copies Required")
Selection.EntireRow.Copy
Sheets(SheetName).Select
ActiveCell.Range("A1:A" & NRow).EntireRow.Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Range("A" & NRow).Offset(1, 0).Select
Sheets(Datasheet).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub