Sub Repackage() 
    Dim Source As Worksheet
    Dim Dest As Worksheet
    Dim LastCol As Long
    Dim ColCount As Long
    
    Set Source = Worksheets("Sheet1") 'change if needed
    Set Dest = Worksheets.Add
    Dest.[a1:g1] = Array("Col1", "Col2", "Col3", "Col4", "Col5", "Col6", "Col7")
    LastCol = Source.Cells(5, Source.Columns.Count).End(xlToLeft).Column
    
    For ColCount = 1 To LastCol
        If Source.Cells(5, ColCount) <> "" Then ProcessColumn Source, Dest, ColCount
    Next 
End Sub 
Private Sub ProcessColumn(ByRef Source As Worksheet, ByRef Dest As Worksheet, ByVal ColNum As Long) 
    Dim arr() As String
    Dim SourceR As Long
    Dim DestR As Long
    Dim LastR As Long
    Dim Cols As Long
    Dim FirstOne As Boolean
    
    DestR = Dest.Cells(Dest.Rows.Count, 1).End(xlUp).Row
    LastR = Source.Cells(Dest.Rows.Count, 1).End(xlUp).Row
    FirstOne = True
    
    For SourceR = 5 To LastR
        If Cols = 0 And Source.Cells(SourceR, ColNum) <> "" Then
            If Not FirstOne Then
                DestR = DestR + 1
                Dest.Cells(DestR, 1).Resize(1, UBound(arr)).Value = arr
            Else
                FirstOne = False
            End If
            Cols = 1
            ReDim arr(1 To Cols) As String
            arr(1) = Source.Cells(SourceR, ColNum)
        ElseIf Source.Cells(SourceR, ColNum) <> "" Then
            Cols = Cols + 1
            ReDim Preserve arr(1 To Cols) As String
            arr(UBound(arr)) = Source.Cells(SourceR, ColNum)
        Else
            Cols = 0
        End If
    Next
    
    DestR = DestR + 1
    Dest.Cells(DestR, 1).Resize(1, UBound(arr)).Value = arr
    
End Sub