Creating Copies of a Row and filtering a value

[Brenkenathan]

OK, I am lost on how to do something as I am not strong with macros BUT I think you guys maybe able to save me hours of work.

I have an output spreadsheet that has roughly 100 rows of data.
In column D I was suppose to have a Name but I now have a listing of name some have 2 names some up to 8 names that are separated with a carriage return
In Column C I have the count of how many values are in Column D

What I need is each row copied X amount of times where X = the number is Column C
And when each is copied I need the value in D to be unique to that list so if it had values X and Y in column D. I now need D1 = X and D2 = Y

Can anyone help because manually this could take HOURS of work

 

[Fluff]

Try this

Sub CopySplitOnCell()

    Dim Cnt As Long
    Dim Splt As Long
    Dim Qty As Long

Application.ScreenUpdating = False

    For Cnt = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("C" & Cnt).Value > 1 Then
            Splt = Range("C" & Cnt).Value
            Rows(Cnt).copy
            Rows(Cnt).Resize(Splt - 1).Insert
            For Qty = 0 To Splt - 1
                Range("D" & Cnt + Qty).Value = Split(Range("D" & Cnt + Qty), Chr(10))(Qty)
            Next Qty
        End If
    Next Cnt

End Sub

 

[Fluff]

Slightly better method would be

Sub CopySplitOnCell()

    Dim Cnt As Long
    Dim Splt As Long
    Dim Qty As Long

Application.ScreenUpdating = False

    For Cnt = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("C" & Cnt).Value > 1 Then
            Splt = Range("C" & Cnt).Value
            Rows(Cnt).copy
            Rows(Cnt).Resize(Splt - 1).Insert
                Range("D" & Cnt).Resize(Splt).Value = Application.Transpose(Split(Range("D" & Cnt), Chr(10)))
        End If
    Next Cnt
Application.CutCopyMode = False
End Sub