VBA for transposing some data to a new sheet

TeivaC 

A variant:

Sub DuplicateProductsForSizes()
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim SourceRow As Range
    Dim ProductRange As Range
    Dim SizeColumn As Long
    Dim Size As Variant
    
    Application.ScreenUpdating = False
    Set SourceSheet = ThisWorkbook.Sheets("BL")
    On Error Resume Next
    Set TargetSheet = ThisWorkbook.Worksheets("Receiving BL")
    On Error GoTo 0
    If TargetSheet Is Nothing Then
        Set TargetSheet = ThisWorkbook.Sheets.Add
        TargetSheet.Name = "Receiving BL"
    Else
        TargetSheet.UsedRange.Clear
    End If
    Set TargetRange = TargetSheet.Range("A1")
    SourceSheet.Range("A7:F7").Copy TargetRange.Resize(1, 6)
    TargetSheet.Range("G1:H1").Value = Array("Size", "Qty")
    Set TargetRange = TargetSheet.Range("A2")
    Set SourceRange = SourceSheet.Range("A8")
    Do While SourceRange.Value <> 0
        Set ProductRange = SourceRange.Resize(1, 6)
        For SizeColumn = 15 To 21 ' O to U
            Size = SourceRange.Offset(0, SizeColumn - 1)
            If Size <> 0 Then
                ProductRange.Copy TargetRange.Resize(1, 6)
                TargetRange.Offset(0, 6).Value = SourceSheet.Cells(7, SizeColumn).Value
                TargetRange.Offset(0, 7).Value = Size
                Set TargetRange = TargetRange.Offset(1, 0)
            End If
        Next SizeColumn
        Set SourceRange = SourceRange.Offset(1, 0)
    Loop
    TargetSheet.Range(TargetSheet.Range("F1"), TargetRange.Offset(-1, 5)).Copy
    TargetSheet.Range(TargetSheet.Range("G1"), TargetRange.Offset(-1, 7)).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub