1.在 Sheet1 準備好資料
2.執行 MainLoop
3.結果放在 Sheet2

Sub MainLoop()
    bFirst = True
    R = 2
    
    savedItem = ""
    savedQuantity = ""
    savedReference = ""
    savedPart = ""
    savedFootprint = ""
    
    Do While Sheets("Sheet1").Cells(R, 3) <> ""
                
        If bFirst = True Then
            savedItem = Sheets("Sheet1").Cells(R, 1)
            savedQuantity = Sheets("Sheet1").Cells(R, 2)
            savedReference = Sheets("Sheet1").Cells(R, 3)
            savedPart = Sheets("Sheet1").Cells(R, 4)
            savedFootprint = Sheets("Sheet1").Cells(R, 5)
            
            bFirst = False
        Else
            If Sheets("Sheet1").Cells(R, 1) = "" And Sheets("Sheet1").Cells(R, 2) = "" Then
                savedReference = savedReference & Sheets("Sheet1").Cells(R, 3)
            Else
                Call AddRowSheet2(savedItem, savedQuantity, savedReference, savedPart, savedFootprint)
                
                savedItem = Sheets("Sheet1").Cells(R, 1)
                savedQuantity = Sheets("Sheet1").Cells(R, 2)
                savedReference = Sheets("Sheet1").Cells(R, 3)
                savedPart = Sheets("Sheet1").Cells(R, 4)
                savedFootprint = Sheets("Sheet1").Cells(R, 5)
            End If
        End If
                
        R = R + 1
    Loop
    
    Call AddRowSheet2(savedItem, savedQuantity, savedReference, savedPart, savedFootprint)
End Sub
Sub AddRowSheet2(ByVal pItem, ByVal pQuantity, ByVal pReference, ByVal pPart, ByVal pFootprint)
    
    arrRef = Split(pReference, ",")
    
    For nI = 0 To UBound(arrRef) Step 10
        sRef = ""
        For nJ = nI To WorksheetFunction.Min(nI + 9, UBound(arrRef))
            sRef = sRef & arrRef(nJ) & IIf(nJ = UBound(arrRef), "", ",")
        Next nJ
        
        R = Range("Sheet2!C65536").End(xlUp).Row + 1
        
        If nI = 0 Then
            Sheets("Sheet2").Cells(R, 1) = pItem
            Sheets("Sheet2").Cells(R, 2) = pQuantity
            Sheets("Sheet2").Cells(R, 4) = pPart
            Sheets("Sheet2").Cells(R, 5) = pFootprint
        End If
        Sheets("Sheet2").Cells(R, 3) = sRef
    Next nI
    
End Sub