Макрос который создаст новую пустую строку через строку - VBA

Формулировка задачи:

Добрый день! Имеется excel файл, в оригинальном файле заполнено 50 тыс. строк x 60 столбцов (количество заполненных столбцов меняется, может быть как больше так и меньше), для примера прикладываю образец во вложении (

пример исходного файла на листе 1

). Напишите пожалуйста макрос который будет создавать пустую строку, через каждую заполненную (

пример результата на листе 2

) P.S. Если есть другие варианты которые приведут к решению поставленной задачи, пожалуйста расскажите о них.

Решение задачи: «Макрос который создаст новую пустую строку через строку»

textual
                            Листинг программы 
                        

                            Sub tt()
    Dim arr(), arr1(), i As Long, j As Long, rng As Range
    Set rng = Application.InputBox("Выделите диапазон", , , , , , , 8)
    If rng Is Nothing Then Exit Sub
    If rng.Rows.Count < 2 Then Exit Sub
    arr = rng
    rng.ClearContents
    ReDim arr1(1 To UBound(arr) * 2, 1 To UBound(arr, 2))
    For i = 1 To UBound(arr1) Step 2
        For j = 1 To UBound(arr, 2)
            arr1(i, j) = arr(WorksheetFunction.RoundUp(i / 2, 0), j)
        Next
    Next
    rng(1, 1).Resize(UBound(arr1), UBound(arr1, 2)) = arr1
End Sub
                        