Format 1 row in excel to many rows incrementally by range in row until blank cell

Here is a Normalization Macro I developed awhile ago. It should get you on the right path and you may have to modify it to meet your specific needs as this was developed with only one static column (column A).

Option Explicit


Sub Normalize()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lrt As Long
    Dim lc As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False

    For i = 1 To lr
        lrt = s2.Range("B" & Rows.Count).End(xlUp).Row + 1
        lc = s1.Cells(i, Columns.Count).End(xlToLeft).Column
        s1.Range("A" & i).Copy s2.Range("A" & lrt)
        s1.Range(Cells(i, 2), Cells(i, lc)).Copy
        s2.Range("B" & lrt).PasteSpecial xlPasteValues, , , True
        Application.CutCopyMode = False
    Next i

    lrt = s2.Range("B" & Rows.Count).End(xlUp).Row
    For i = 3 To lrt
        If s2.Range("A" & i) = "" Then
            s2.Range("A" & i) = s2.Range("A" & i - 1)
        End If
    Next i

    Application.ScreenUpdating = True

End Sub

Hi jmoore3535

Welcome to the forum. Can give this a go...

Option Explicit
Sub MoveMe()
Dim lRow As Long, nRow As Long, lCol As Long, _
r As Long, c As Long
Application.ScreenUpdating = False
lRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
nRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
With Sheet1
    For r = 1 To lRow
        lCol = .Cells(r, .Columns.Count).End(xlToLeft).Column
            For c = 3 To lCol
                If .Cells(r, c) > "" Then
                    Range(.Cells(r, 1), .Cells(r, 2)).Copy Destination:=Sheet2.Cells(nRow, 1)
                    Sheet2.Cells(nRow, 3) = .Cells(r, c)
                    nRow = nRow + 1
                End If
            Next c
    Next r
End With
Application.ScreenUpdating = True
End Sub

Pleasure...Thanks for rep points
Please mark thread as solved...