Sub Razbienie()
Dim i As Long
Dim iLastRow As Long
Dim j As Long
Dim arr
Dim arr_n
Dim Kol_vo As Long
Dim n As Long
Dim iCounter As Long
  Kol_vo = 100
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
n = Int(iLastRow / Kol_vo) + 1
arr = Range("A1:A" & iLastRow).Value
ReDim arr_n(1 To Kol_vo, 1 To n * 2)
    iCounter = 1
  For j = 1 To UBound(arr_n, 2) Step 2
    For i = 1 To UBound(arr_n)
      If iCounter <= iLastRow Then
        arr_n(i, j) = iCounter
        arr_n(i, j + 1) = arr(iCounter, 1)
        iCounter = iCounter + 1
      End If
    Next
  Next
  With Worksheets("Лист2")
    .Cells.Clear
    .Range("A1").Resize(Kol_vo, n * 2) = arr_n
    .Range(.Cells(1, n + 1), .Cells(100, n * 2)).Cut .Range("A103")
  End With
End Sub

Sub tt()
    k_ = 100
    With Worksheets("Лист2")
        .Cells.Clear
        For i = 1 To Cells(Rows.Count, 1).End(3).Row / k_
            .Cells(2, i).Resize(k_) = Cells(1, 1).Offset(k_ * (i - 1)).Resize(k_).Value
        Next i
        .Select
    End With
End Sub

.Range(.Cells(1, n + 1), .Cells(100, n * 2)).Cut .Range("A103")

Sub tt()
    k_ = 100
    kk_ = 7
    n_ = Cells(Rows.Count, 1).End(3).Row
    With Worksheets("Лист2")
        Application.ScreenUpdating = 0
        cal_ = Application.Calculation
        Application.Calculation = 3
        .Cells.Clear
        r0_ = 2
        x_ = k_
        For j = 1 To -Int(-n_ / k_ / kk_)
            For i = 2 To kk_ * 2 Step 2
                a_ = k_ * (i / 2 + (j - 1) * kk_)
                If a_ > n_ Then
                    x_ = n_ - a_ + k_
                    fl_ = 1
                End If
                .Cells(r0_, i).Resize(x_) = Cells(1, 1).Offset(a_ - k_).Resize(x_).Value
                .Cells(r0_, i - 1) = k_ * (i / 2 - 1 + (j - 1) * kk_) + 1
                .Cells(r0_, i - 1).Resize(x_).DataSeries
                If fl_ Then Exit For
            Next i
            r0_ = r0_ + k_ + 2
        Next j
        Application.Calculation = cal_
        Application.ScreenUpdating = 1
        .Select
    End With
End Sub