Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel
Previous Topic Next Topic

Duplicate rows based on cell value [Solved/Closed]

Report
Posts
28
Registration date
Monday February 3, 2014
Status
Member
Last seen
June 23, 2014
 -
Posts
2774
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 13, 2021
 -
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

Answer 1 / 2
Posts
2774
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 13, 2021
 465
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
View all 14 comments
Report
Posts
2774
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 13, 2021
 465
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
Report
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.
Report
Blocked Profile
@TrowaD--Your code is always so neatly formatted! Managers Dream! Way to go!
Report
Posts
2774
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 13, 2021
 465
Thanks Fireburn, looking forward to it!
Report
Posts
2774
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
July 13, 2021
 465
And thanks to you Mark.

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

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!