Sub Копирование()
    Kol = InputBox("Количество дублей:", "Ввод количества", 4)
    
    col = 3 'Стартовая колонка
    
    'По вертикали
    i = 2 'Стартовая ячейка
    While ActiveSheet.Cells(i, col).Value <> ""
      i = i + 1
    Wend
    Size = i - 2
    
    colset = 7 'номер колонки куда вставляем
    ActiveSheet.Range(Cells(2, col), Cells(1 + Size, col)).Copy
    For k = 0 To Kol - 1
      ActiveSheet.Cells(2 + Size * k, colset).Activate
      ActiveSheet.Paste
    Next
    Application.CutCopyMode = False
    
    st1 = Left(ActiveSheet.Cells(1, colset).Address, Len(ActiveSheet.Cells(1, colset).Address) - 1)
    
    'Сортируем
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range(st1 & "2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(st1 & "2:" & st1 & Format(2 + Size * (Kol)))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveSheet.Cells(1, colset).Activate
End Sub

Sub ss()
    Dim rng As Range
    With Range([A1], [A1].End(xlDown))
        Set rng = .Resize(.Count * [B1])
        .Copy rng
        With ActiveSheet.Sort
            With .SortFields
                .Clear
                .Add rng, 0, 1, , 0
            End With
            .SetRange rng: .Header = 2
            .MatchCase = 0: .Orientation = 1
            .SortMethod = 1: .Apply
        End With
    End With
End Sub