Duplicate rows based on cell value [Solved/Closed]

Posts
28
Registration date
Monday February 3, 2014
Status
Member
Last seen
June 23, 2014
- - Latest reply: TrowaD
Posts
2538
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 17, 2019
- Mar 13, 2014 at 12:07 PM
Hi,

Can somebody help me out with this. I want to duplicate rows based on input in a cell. can it be done in VB or macro or formula array? User will only input value in a cell (e.g. F1)

A B C D E F (eg F1 is the input cell)
1 2 3 4 5 2

and should look like this after inputting value in F1

A B C D E F
1 2 3 4 5 2
1 2 3 4 5
1 2 3 4 5

Thank you.
See more 

2 replies

Posts
2538
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 17, 2019
369
0
Thank you
Hi Fireburn,

Try this code and let me know how it works:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer

If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) = False Then Exit Sub
If Target.Value = 0 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

x = Target.Value

Do
Range(Cells(Target.Row, "A"), Cells(Target.Row, "E")).Copy
Range(Cells(Target.Row + 1, "A"), Cells(Target.Row + 1, "E")).Insert Shift:=xlDown
x = x - 1
Loop Until x = 0

Application.CutCopyMode = False
End Sub

Best regards,
Trowa
TrowaD
Posts
2538
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 17, 2019
369 -
Hi Fireburn,

For that use the following code:
Sub RunMe()
Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name <> "Master" Then
ws.Activate
For Each cell In Range("C:C")
If cell.Value <> vbNullString Then
Range(Cells(cell.Row, "C"), Cells(cell.Row, "M")).Copy _
Sheets("Master").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cell
End If
Next ws

Sheets("Master").Activate

End Sub

Best regards,
Trowa
fireburn
Posts
28
Registration date
Monday February 3, 2014
Status
Member
Last seen
June 23, 2014
-
HI,

Thank you for always there to help me out. I owe you a beer :-)
It worked.
ac3mark
Posts
13035
Registration date
Monday June 3, 2013
Status
Moderator
Last seen
October 11, 2019
1475 -
@TrowaD--Your code is always so neatly formatted! Managers Dream! Way to go!
TrowaD
Posts
2538
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 17, 2019
369 -
Thanks Fireburn, looking forward to it!
TrowaD
Posts
2538
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 17, 2019
369 -
And thanks to you Mark.

I have great respect for you, so it means a lot to me!
Posts
28
Registration date
Monday February 3, 2014
Status
Member
Last seen
June 23, 2014
0
Thank you
Thank you for helping me out. Greatly appreciate it.