• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel vba to duplicate copy and paste rows for multiple times

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

Code:
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
 

Attachments

  • Book4.xlsx
    11.3 KB · Views: 12
Last edited by a moderator:
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.​
 
Code:
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
 

Attachments

  • Book4.xlsx
    12.5 KB · Views: 15
Hi Sir,

i have completed this task..

Code:
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
 
According to your attachment an Excel basics VBA demonstration for starters :​
Code:
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 !​
 
Back
Top