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 7140 Registration date Saturday April 7, 2007 Status Moderator Last seen March 25, 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
5
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.
0
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
0