Insert Rows according cells value in excel table

Closed
Posts
1
Registration date
Friday June 7, 2013
Status
Member
Last seen
June 7, 2013
-
Posts
2849
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 27, 2022
-
Dear All,

I need a Module that allowed me when I run it to add Rows down according upper cells Value for Example;

Total Names
2 Sami
5 Rami

Then after apply the Module I need like this;

Total Names
2 Sami
2 Sami
5 Rami
5 Rami
5 Rami
5 Rami
5 Rami


Then I will thank you.

1 reply

Posts
2849
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
January 27, 2022
491
Hi Loftier,

Here you go:
Sub test()
Dim x, y, cRow As Integer

cRow = 1

Do
    If Range("A" & cRow).Value > 1 Then
        x = Range("A" & cRow).Value
        y = Range("A" & cRow).Value
        Do
            Range("A" & cRow + 1).EntireRow.Insert Shift:=xlUp
            Range(Cells(cRow, "A"), Cells(cRow, "B")).Copy
            Range("A" & cRow + 1).PasteSpecial
            x = x - 1
        Loop Until x = 1
        cRow = cRow + y
    End If
Loop Until Range("A" & cRow).Value = vbNullString

Application.CutCopyMode = False

End Sub

Best regards,
Trowa