Loop through rows, store columns, paste to new sheet as rows - excel

Question

I have a data export that pulls customer info with one row for each parent, and 8 port columns (port1, port2, etc... to port8). I need to transpose the port columns into a unique record for each port that retains the customer info in the parent. The source sheet can have 100+ records, the destination sheet will have a maximum of x8 as many records as source sheet because no row has more than 8 ports. I am struggling with how to proceed from here. My idea was to loop through each SourceData row, build an array for each row that contains all ports field values, transpose this into a new sheet and paste, and continue this until last row. The struggle is the paste destination must paste in gaps of 8, then the sheet must be filtered so blanks are not present, and then vlookup against the remaining data.
Source Format
Desired Format
Sub test3()
Dim wb As Workbook
Dim sourceData As Worksheet
Dim outputData As Worksheet
Set wb = Workbooks("Book1")
Set sourceData = Worksheets("Sheet1")
Set outputData = Worksheets("Sheet2")
Dim Rng As Range
Dim ctr As Long
ctr = 2
Dim iCol As Long, lCol As Long, lRow As Long 'iteration column, last column
Const fCol = 15 'first column
With sourceData
lCol = 22 'last used column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row 'find last used row
For i = 2 To lRow
For iCol = fCol To lCol
Set Rng = Cells(i, iCol)
outputData.Cells(ctr, fCol).Value = Rng
ctr = ctr + 1
Next iCol
Next i
End With
End Sub

Answer 1

Edit 2: updated to include extra rows as output.
Lightly tested...
Sub test3()
Dim wsSrc As Worksheet, srcData, outData, r As Long
Dim c As Long, rOut As Long, p As Long, prt
'get input data as array
Set wsSrc = Worksheets("Sheet1")
srcData = wsSrc.Range("A2:W" & wsSrc.Cells(Rows.Count, "A").End(xlUp).Row).Value
'size output array to max potential size (+ added some space for pepwave/remote cases)
ReDim outData(1 To 10 * UBound(srcData, 1), 1 To 16)
For r = 1 To UBound(srcData, 1) 'loop input data rows
For p = 1 To 8 'loop ports
prt = srcData(r, 14 + p)
If Len(prt) > 0 Then 'if any port value...
rOut = rOut + 1 'add output row
For c = 1 To 14 'populate common columns
outData(rOut, c) = srcData(r, c)
Next c
outData(rOut, 15) = prt 'add port value
outData(rOut, 16) = srcData(r, 23) 'col W value
End If
Next p
'test to see if we're adding additional rows...
If InStr(1, srcData(r, 6), "pepwave", vbTextCompare) > 0 Then
rOut = rOut + 1
'populate pepwave row from srcdata (r,x)
End If
If InStr(1, srcData(r, 6), "data remote", vbTextCompare) > 0 Then
rOut = rOut + 1
'populate data remote row from srcdata (r,x)
End If
'done testing for additional rows
Next r
If rOut > 0 Then
Worksheets("Sheet2").Range("A2").Resize(rOut, UBound(outData, 2)).Value = outData
End If
End Sub