Copy Paste to another sheet

[erenkey]

I have a spreadsheet that has First Name, Last Name, and a number in Columns ABC. Is there a way to automatically copy and paste each name into another sheet the same number of times as the number shown?

Example:

Sheet1
A........................B............................C
First Name............Last Name................Number
John Smith 5
Tom Jones 3


Sheet2

A........................B
First Name............Last Name
John Smith
John Smith
John Smith
John Smith
John Smith
Tom Jones
Tom Jones
Tom Jones


Is this possible?

 

[daverunt]

Hi,

see if this is ok.
I have used sheet2 as the list of names change to suit throughout code and sheet 3 as the target

Sub Repeat_Names()
Worksheets("Sheet2").Select
    Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 
    For Each cell In Rng
    num = cell.Row
    x = cell.Offset(0, 2).Value
    For i = 1 To x
 
    Worksheets("Sheet2").Range("A" & num & ":B" & num).Copy
 
    Worksheets("Sheet3").Select
    Range("A1").Activate
 
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
Selection.PasteSpecial
Next
Next
End Sub

 

[erenkey]

Do I paste this in "Sheet 2" or "This Workbook"?

 

[erenkey]

I pasted it in "This Workbook" and tried to run it but I got a Type mismatch error.

 

[daverunt]

Hi,

Try it on a copy of the workbook.

Open the workbook that contains your names list.
Open the VBA editor (Alt F11)
On the left window at the top should be VBA project - right-click and select insert > module
Paste the code in the module.

Then select run on the toolbar.

Post any errors and the line that caused it.
What is the name of the sheet you have the list of names on?
The code below has been changed to expect sheet1 and will split the names to sheet2.

Sub Repeat_Names()
rn = 1
Worksheets("Sheet1").Select
    Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 
    For Each cell In Rng
    num = cell.Row
 
    x = cell.Offset(0, 2).Value
 
    For i = 1 To x
 
    Worksheets("Sheet1").Range("A" & num & ":B" & num).Copy Destination:=Worksheets("Sheet2").Range("A" & rn)
    rn = rn + 1
 
Next
Next
End Sub

 

[erenkey]

I ran it and got a run-time error '13' Type mismatch. I clicked on the debug button and it highlighted

For i = 1 To x

 

[GTO]

Just another way. Please note that I happened to use the default codenames of sheet3 and sheet4.

Option Explicit
    
Sub exa4()
Dim rng As Range, Cell As Range
    
    With Sheet3
        Set rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        
        For Each Cell In rng
            Sheet4.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(Cell.Offset(, 2).Value, 2) = Cell.Resize(, 2).Value
        Next
    End With
End Sub

 

[daverunt]

Hi ,

does column C only contain numbers.

Step through the code in the VBA editor by using F8 until you get to

For i = 1 To x

hover over x on the previous line and it should show its value?

 

[erenkey]

Everything is numbers except for the Header Row. Do I need to take that out?

 

[daverunt]

Sorry,

didn't take the headers into account.

The range should start from A2.
Change the red bit.

Set Rng = Range(Range("[COLOR=red][B]A2[/B][/COLOR]"), Range("A" & Rows.Count).End(xlUp))