Macro to populate cells with n values

Manrique

New Member
Joined
Aug 20, 2014
Messages
24
Hello MrExcelers,

Need help to create a macro in excel 2013 to populate cells with n values from one sheet to another.

Thank you.


A3
B3
C2
D1

<tbody>
</tbody>

Result:
A
A
A
B
B
B
C
C
D

<tbody>
</tbody>
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Code:
Sub transcribeKinda()

    Dim startSheet As Worksheet
    Dim endSheet As Worksheet
    
    Dim value As String
    Dim amount As Integer
    
    Dim startRow As Integer
    Dim endRow As Long
    
    Dim nextRow As Long
    
    Set startSheet = ThisWorkbook.Sheets("TableSheet") ' CHANGE ME
    Set endSheet = ThisWorkbook.Sheets("ResultsSheet") ' CHANGE ME
    
    startRow = 1
    endRow = startSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    nextRow = 1
    
    For x = startRow To endRow Step 1
    
        value = startSheet.Cells(x, 1)
        amount = startSheet.Cells(x, 2)
        
            For y = 1 To amount Step 1
                endSheet.Cells(nextRow, 1) = value
                nextRow = nextRow + 1
            Next y
    Next x
End Sub

This code assumes no headers on the table sheet.
 
Upvote 0
This assumes your data sheet is active when you run the macro and your data begin in A1 on the activesheet.
Code:
Sub n()
Dim lR As Long, vA As Variant, R As Range, S1 As Worksheet, S2 As Worksheet
Set S1 = ActiveSheet
lR = S1.Range("A" & Rows.Count).End(xlUp).Row
Set R = S1.Range("A1:B" & lR)
vA = R.Value
Application.DisplayAlerts = False
On Error Resume Next
Sheets("n").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set S2 = Sheets.Add(after:=S1)
S2.Name = "n"
lR = 1
With S2
    For i = LBound(vA, 1) To UBound(vA, 1)
        .Cells(lR, 1).Resize(vA(i, 2)).Value = vA(i, 1)
        lR = S2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Next i
End With
End Sub
 
Upvote 0
Its my first time in a forum like this one. It's amazing how people is willing to share their knowledge... thanks.
Although this have been very helpful, I'm having difficulty with my actual workbook. I'll try to be more clear with my request:

So sheet1: B7,B8... be copied on sheet2:B6,B7... as many times as sheet1 column C.

Very grateful.

PList.png
 
Upvote 0
Based on your expanded sheet layout and description I've modified the code I posted earlier:
Code:
Sub n()
Dim lR As Long, vA As Variant, R As Range, S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("sheet1")
Set S2 = Sheets("sheet2")
lR = S1.Range("B" & Rows.Count).End(xlUp).Row
Set R = S1.Range("B7:C" & lR)
vA = R.Value
lR = 6
With S2
    For i = LBound(vA, 1) To UBound(vA, 1)
        .Cells(lR, 2).Resize(vA(i, 2)).Value = vA(i, 1)
        lR = S2.Range("B" & Rows.Count).End(xlUp).Row + 1
    Next i
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,217,352
Messages
6,136,058
Members
449,987
Latest member
lil_Sassy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top