Inserting rows and move/pull data from a horizontal layout to a vertical layout

Question

I have a table of data such that specific columns of the information needs to be converted from a horizontal layout and inserted below the initial row. To Make things more complex any column with a value of zero needs to be ignored and each row may have a different column with a zero.

I have gotten as far as inserting rows for the total count of columns with a value greater than 0 by using a countif formula in column "Q" for this vba.

Sub H2V()
' H2V Macro
' Integrate vertical UB-04 codes
    Worksheets("Sheet1 (2)").Activate

    Dim r, count As Range
    Dim LastRow As Long
    Dim temp As Integer

    Set r = Range("A:P")
    Set count = Range("Q:Q")
    LastRow = Range("B" & Rows.count).End(xlUp).Row

    For n = LastRow To 1 Step -1
        temp = Range("Q" & n)

        If (temp > 1) Then
            Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
        End If

    Next n

End Sub

But I cannot for the life of me figure out how to pull the data from the horizontal set into the newly created rows to make it vertically integrated.

Revised Example (more complete):

Answer 1

you could try this

Option Explicit

Sub main()
    Dim headers As Variant, names As Variant, data As Variant
    Dim iRow As Long

    With Worksheets("Sheet1 (2)")
        With .Range("A1").CurrentRegion
            headers = Application.Transpose(Application.Transpose(.Offset(, 1).Resize(1, .Columns.Count - 1).Value))
            names = Application.Transpose(.Offset(1).Resize(.Rows.Count - 1, 1).Value)
            data = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Value
            .ClearContents
            .Resize(1, 3).Value = Array("Name", "Object", "Value")
        End With

        For iRow = 1 To UBound(data)
            With .Cells(.Rows.Count, "B").End(xlUp)
                .Offset(1, -1).Value = names(iRow)
                .Offset(2, 0).Resize(UBound(headers)).Value = Application.Transpose(headers)
                .Offset(2, 1).Resize(UBound(data)).Value = Application.Transpose(Application.index(data, iRow, 0))
            End With
        Next

        With .Range("B3", Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeConstants)
            .Offset(, 1).Replace what:="0", replacement:="", lookat:=xlWhole
            .Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With
    End With
End Sub