Macro to copy rows multiple times

[JHolden47]

I have seen a number of similar threads on this subject, however I have a variation.

I have a sheet with 211 rows, each row needs to be copied and inserted multiple times. The number of times it needs to be copied is in a cell within each row (Col G). So The first row has the number 14 in Col G so this needs to be copied 14 times below, this then needs to loop for all the 211 rows.

Any ideas?

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub JHolden47()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
   Next i
End Sub

 

[JHolden47]

That worked perfectly, thanks ver much for your help. The next step is I want to insert a row and add a unique ID which is the ID already in Col H with AA, AB, AC etc, then repeated for the next group. so

WTL-006-033-4-AA
WTL-006-033-4-AB
WTL-006-033-4-AC
SFC-006-113-4-AA
SFC-006-113-4-AB

 

[Fluff]

How about

Sub JHolden47()
   Dim i As Long, j As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
      For j = 0 To Range("G" & i).Value
         Range("H" & i + j).Value = Range("H" & i + j) & "-A" & Chr(j + 65)
      Next j
   Next i
End Sub

This assumes you will never have more than 26 duplicate rows

 

[JHolden47]

There are several occurrences where I exceed 26 duplicate rows, in one case there are 685, so it needs to repeat AA-AZ, BA-BZ, CA-CZ, DA-DZ etc

 

[Fluff]

Ok, how about

Sub JHolden47()
   Dim i As Long, j As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
      For j = 0 To Range("G" & i).Value
         Range("H" & i + j).Value = Range("H" & i + j) & "-" & Split(Cells(i, j + 27).Address(1, 0), "$")(0)
      Next j
   Next i
End Sub

 

[JHolden47]

Ok, how about

Sub JHolden47()
   Dim i As Long, j As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
      For j = 0 To Range("G" & i).Value
         Range("H" & i + j).Value = Range("H" & i + j) & "-" & Split(Cells(i, j + 27).Address(1, 0), "$")(0)
      Next j
   Next i
End Sub

I tried running that, it deleted the first 14 rows and crashed excel

 

[Fluff]

As that code doesn't delete anything, it sounds like you ahve something else going on.
Do you have any event macros running on that sheet?

 

[JHolden47]

As that code doesn't delete anything, it sounds like you ahve something else going on.
Do you have any event macros running on that sheet?

Just the 2 macros on this thread

 

[Fluff]

Did you run the code from post#6 after running the code from post#2?
If so don't as the one code does both
delete the code you have got & try this, which should be a bit quicker

Sub JHolden47()
   Dim i As Long, j As Long
   
   Application.ScreenUpdating = False
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i).Copy
      Rows(i).Resize(Range("G" & i)).Insert
      For j = 0 To Range("G" & i).Value
         Range("H" & i + j).Value = Range("H" & i + j) & "-" & Split(Cells(i, j + 27).Address(1, 0), "$")(0)
      Next j
   Next i
End Sub