Duplicate rows based on cell value [Solved/Closed]

Report
Posts
28
Registration date
Monday February 3, 2014
Status
Member
Last seen
June 23, 2014
-
TrowaD
Posts
2599
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
March 24, 2020
-
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.
Related:

2 replies

Posts
2599
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
March 24, 2020
401
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
2599
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
March 24, 2020
401
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.
Blocked Profile
@TrowaD--Your code is always so neatly formatted! Managers Dream! Way to go!
TrowaD
Posts
2599
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
March 24, 2020
401
Thanks Fireburn, looking forward to it!
TrowaD
Posts
2599
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
March 24, 2020
401
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

Thank you for helping me out. Greatly appreciate it.