Option Base 1
Option Explicit

Sub proverka() 'Для проверки
Dim i&
Dim x(1 To 77777)
For i = LBound(x) To UBound(x)
      x(i) = i
Next
arToRange x, 1, 1
End Sub

Public Sub arToRange(ByVal arArray, startRow&, startColumn&) 'arArray - входящий массив, _
                      startRow - строка с которой начать выгрузку, _
                      startColumn - колонка с которой начать выгрузку
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ar(50000) ' выгружать будем по 50 тысяч
Dim tmp 'массив для выгрузки остатка
Dim i&, v&, c& ' счетчики
Dim delitel&
Dim ostatok&

If Not UBound(arArray) - LBound(arArray) + 1 <= 50000 Then 'если входящий массив меньше чем 50к, то выгружаем целиком

delitel = Int((UBound(arArray) - LBound(arArray)) / UBound(ar))
      ostatok = (UBound(arArray) - LBound(arArray)) - UBound(ar) * delitel
        
      startRow = 1
      c = 1
      For i = 1 To delitel
          For v = 1 To UBound(ar)
              ar(v) = arArray(c)
              c = c + 1
          Next
      Cells(startRow, startColumn).Resize(UBound(ar)) = Application.WorksheetFunction.Transpose(ar)
      startRow = startRow + UBound(ar)
      Next
        
      v = 1
      If ostatok > 0 Then
          ReDim tmp(1 To ostatok + 1)
          For i = c To UBound(arArray)
              tmp(v) = arArray(i)
              v = v + 1
          Next
      Cells(startRow, startColumn).Resize(UBound(tmp)) = Application.WorksheetFunction.Transpose(tmp)
      End If
Else
      Cells(startRow, startColumn).Resize(UBound(arArray) - LBound(arArray) + 1) = Application.WorksheetFunction.Transpose(arArray)
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub