Excel vba to duplicate copy and paste rows for multiple times

[jawaharprm]

Hi All, can help me with a macro to duplicate rows based on specific cell value in column A?

For example, i have data in 10 rows, then I need the line to be duplicated so it appears 7 times. per number so total row will be 70.

Enclosed file for reference

worked code pasted below

>>> You asked to edit this <<<
>>> use code - tags <<<

sub duplicate()
Dim lr1, lr2 As Long
Dim i As Long
Dim y As Workbook

Set y = ThisWorkbook
With y.Sheets("MARC")

lr2 = Range("A5").Value
lr2 = Range("A" & Rows.Count).End(xlUp).Row
For i = lr2 To 8 Step -1
    Range("A" & i).Copy
    Range("A" & i).Resize(lr2 - 1).Insert shift:=xlShiftDown
Next i
Application.CutCopyMode = False
End With

 

[Marc L]

Hi, first edit your post, select the code then within the 3 dots icon select the Code option, thanks …​

​

As the attachment does not match your explanation so it should be easier to help​

if you attach at least the exact expected result workbook according to your initial attachment.​

​

 

[jawaharprm]

sub duplicate()
Dim lr1, lr2 As Long
Dim i As Long
Dim y As Workbook

Set y = ThisWorkbook
With y.Sheets("MARC")

lr2 = Range("A5").Value
lr2 = Range("A" & Rows.Count).End(xlUp).Row
For i = lr2 To 8 Step -1
Range("A" & i).Copy
Range("A" & i).Resize(lr2 - 1).Insert shift:=xlShiftDown
Next i
Application.CutCopyMode = False
End With

enclosed the attachment what i actually need.

Thanks

 

[jawaharprm]

Hi Sir,

i have completed this task..

Sub Insert_Row() ' insert extra colunm

Dim lr As Long, x As Long, ws As Worksheet

'Set your worksheet as variable
    Set ws = ThisWorkbook.Worksheets("MARC")

'Get last used row of column A and fill array
    lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

'Loop backwards
    For x = lr + 1 To 6 Step -1
        ws.Rows(x).Resize(6).Insert xlShiftDown
    Next x
      
Call fill
End Sub

Private Sub fill()

Dim Drow, j As Integer
Dim y As Workbook, ws As Worksheet

Set y = ThisWorkbook
y.Activate
Set ws = ThisWorkbook.Worksheets("MARC")
Drow = Sheet5.Range("A1048576").End(xlUp).Row + 7 'define last row till last data
    For j = 5 To Drow
        If Sheet5.Range("A" & j).Value = "" Then
            Rows(j).Select
            Selection.FillDown
        End If
    Next j
Call copy_Paste
End Sub

 

[jawaharprm]

it will insert the required blank column and autofill the data till the last row...

 

[Marc L]

According to your attachment an Excel basics VBA demonstration for starters :​

Sub Demo1()
        Dim L&, N%
    With [Sheet1!A1].CurrentRegion.Rows
        L = .Count + 1
    For N = 1 To 6
       .Item("5:" & .Count).Copy .Item(L)
        L = L + .Count - 4
    Next
       .Item("5:" & L - 1).Sort .Cells(5, 1), 1, Header:=2
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[jawaharprm]

Hi Sir,

This is super, thanks if want the decreases or increases the column where should change..

 

[Marc L]

What could that mean ? What did you try so far ? As according to this thread title it's all about rows …​

​

 

[jawaharprm]

Hi Sir
i came how change so thanks...