Macro to populate cells with n values

[Manrique]

Hello MrExcelers,

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

Thank you.


[TABLE="class: grid, width: 100"]
<tbody>[TR]
[TD]A[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

Result:
[TABLE="class: outer_border, width: 100"]
<tbody>[TR]
[TD]A[/TD]
[/TR]
[TR]
[TD]A[/TD]
[/TR]
[TR]
[TD]A[/TD]
[/TR]
[TR]
[TD]B[/TD]
[/TR]
[TR]
[TD]B[/TD]
[/TR]
[TR]
[TD]B[/TD]
[/TR]
[TR]
[TD]C[/TD]
[/TR]
[TR]
[TD]C[/TD]
[/TR]
[TR]
[TD]D[/TD]
[/TR]
</tbody>[/TABLE]

 

[NeonRedSharpie]

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.

 

[JoeMo]

This assumes your data sheet is active when you run the macro and your data begin in A1 on the activesheet.

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

 

[Manrique]

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.

 

[JoeMo]

Based on your expanded sheet layout and description I've modified the code I posted earlier:

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

 

[Manrique]

Thank you.. works perfectly!

 

[JoeMo]

Thank you.. works perfectly!

You are welcome - thanks for the reply.