Insert Rows according cells value in excel table [Closed]

Report
Posts
1
Registration date
Friday June 7, 2013
Status
Member
Last seen
June 7, 2013
-
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
-
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
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
460
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
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!