Step curves

Here we are

Sub PrepareData1()
Dim WkTbl1(), WkTbl2()
Dim WkRg  As Range
Dim I As Long, J As Long, K As Long

    Application.ScreenUpdating = False
    WkTbl1 = Range("A1").CurrentRegion.Offset(1, 0)
    ReDim WkTbl2(1 To 2 * UBound(WkTbl1, 1), 1 To UBound(WkTbl1, 2))
    K = 1: I = 1
    Do
        For J = 2 To UBound(WkTbl1, 2)
            WkTbl2(K, J) = WkTbl1(I, J)
            WkTbl2(K + 1, J) = WkTbl1(I, J)
        Next J
        WkTbl2(K, 1) = WkTbl1(I, 1)
        WkTbl2(K + 1, 1) = WkTbl1(I + 1, 1)
        I = I + 1
        K = K + 2
    Loop While (I <= UBound(WkTbl1, 1) - 1)
    For J = 2 To UBound(WkTbl1, 2)
        WkTbl2(K - 1, J) = Empty
    Next J
    Range("A2").Resize(UBound(WkTbl2, 1), UBound(WkTbl1, 2)) = WkTbl2
    Application.ScreenUpdating = True
End Sub