Repeated cells in same column VBA

[grifdoogindoggy]

I am struggling to create a simple loop that will allow me to repeat a cell value down a column for a number of my choosing.

I want to turn this:
A1
A2
A3

Into this ("2", for example):
A1
A1
A2
A2
A3
A3

Anything helps! Thank you.

 

[JackDanIce]

Try:

Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    x = InputBox("Enter repetition value: ")
    v = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        For i = 2 To x
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
        Next i
        Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[grifdoogindoggy]

Thank you, that works perfect!

 

[JackDanIce]

You're welcome, glad it's resolved

 

[grifdoogindoggy]

Try:

Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    x = InputBox("Enter repetition value: ")
    v = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        For i = 2 To x
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
        Next i
        Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
    End If
    
    Application.ScreenUpdating = True
    
End Sub

How would I print this to a new sheet?

 

[JackDanIce]

Change parts in red to suit:

Sub M1()

    Dim v   As Variant
    Dim x   As Long
    Dim i   As Long
    
    Dim srcSheet    As Worksheet
    Dim destSheet   As Worksheet
    
    Set srcSheet = Sheets("Source")
    Set destSheet = Sheets("Destination")
    
    x = InputBox("Enter repetition value: ")
    v = srcSheet.Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Application.ScreenUpdating = False
    
    If x > 1 Then
        With destSheet
            For i = 2 To x
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(v, 1)).Value = v
            Next i
            .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row).Sort key1:=Cells(1, 1), order1:=xlAscending
        End With
    End If
    
    Application.ScreenUpdating = True
    
    Set srcSheet = Nothing: Set destSheet = Nothing
    
End Sub