VBA to copy rows within the same sheet

[shimon.amar]

Dear fellows,

My boss gave me an assignment that I can't find a way to do it by macro.

assume I have database with lines -

Name	Code Number	Sub-code	Date	Amount
John	1234		12.12.12	100
Jack	5678		12.12.13	300
Joe	9876		11.12.12	430

<tbody>
</tbody>

What I basically need to do is to duplicate each row 3 times and put the duplicated rows beneath the original rows.
For column "Sub-code" need to put numbers for each copied line (1, 2, 3).
For column "Amount" need to divide by 3 for each copied line.

Basically the data after macro should be like

Name	Code Number	Sub-code	Date	Amount
John	1234		12.12.12	100
John	1234	1	12.12.12	33.33
John	1234	2	12.12.12	33.33
John	1234	3	12.12.12	33.33
Jack	5678		12.12.13	300
Jack	5678	1	12.12.13	100
Jack	5678	2	12.12.13	100
Jack	5678	3	12.12.13	100

<tbody>
</tbody>

****** id="cke_pastebin" style="position: absolute; top: 382px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

1234

<tbody>
</tbody>

</body>Thank in advance, very much appreciated

 

[Fluff]

How about

Sub CopyRows3x()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i + 1).Resize(3).Insert
      Rows(i).Resize(4).FillDown
      Range("C" & i + 1).Resize(3).Value = Application.Transpose(Array(1, 2, 3))
      Range("E" & i + 1).Resize(3).Value = Range("E" & i).Value / 3
   Next i
End Sub

 

[shimon.amar]

How about

Sub CopyRows3x()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rows(i + 1).Resize(3).Insert
      Rows(i).Resize(4).FillDown
      Range("C" & i + 1).Resize(3).Value = Application.Transpose(Array(1, 2, 3))
      Range("E" & i + 1).Resize(3).Value = Range("E" & i).Value / 3
   Next i
End Sub

Works great!! thank you very much!!

 

[Fluff]

Glad to help & thanks for the feedback