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
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
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
Thank you.. works perfectly!