This should work:
It assumes you have a sheet "components" which has your bills of material.
It creates a load sheet as a separate sheet. HTH


Sub CreateLoadSheet()
Dim DataArray(500, 2) As Variant
Dim ToShip(500, 2) As Variant
Dim ToShipCntr As Long
Dim Nbr As Long
Dim X As Long
Dim Y As Long

Let X = 2
'first we'll look through your list of items to ship, starting in row 2, col A
Do While True
If Cells(X, 1).Value = Empty Then Exit Do
ToShipCntr = ToShipCntr + 1
ToShip(ToShipCntr, 1) = Cells(X, 1).Value
X = X + 1
Loop
'now we know what is shipping. So go get components.
Sheets("Components").Select
X = 2
Do While True
If Cells(X, 1).Value = Empty Then Exit Do
For Y = 1 To ToShipCntr
If Cells(X, 1).Value = ToShip(Y, 1) Then
ToShip(Y, 2) = ToShip(Y, 2) + 1 'counter
Nbr = Nbr + 1
DataArray(Nbr, 1) = Y
DataArray(Nbr, 2) = Cells(X, 2).Value
End If
Next
X = X + 1
Loop

Dim MyEntries As String
Workbooks.Add Template:="Workbook"
MyEntries = ActiveWorkbook.Name
Cells(1, 1).Value = "Item"
Cells(1, 2).Value = "Component"
X = 1
For Y = 1 To ToShipCntr
For Z = 1 To Nbr
If DataArray(Z, 1) = Y Then
X = X + 1
Cells(X, 1).Value = ToShip(Y, 1)
Cells(X, 2).Value = DataArray(Z, 2) & " of " & ToShip(Y, 2)
End If
Next
Next

Range("C1").Select
ActiveCell.FormulaR1C1 = "Package #"
For Y = 1 To X - 1
Cells(Y + 1, 3).Select
ActiveCell.FormulaR1C1 = "________"
Next
Cells.Select
Cells.EntireColumn.AutoFit
Set PrtRng = Range(Cells(1, 1), Cells(X + 2, 3))
With ActiveSheet.PageSetup
.Zoom = False
.PrintArea = PrtRng.Address
.PrintTitleRows = "$1:$1"
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 10
End With
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
ActiveWindow.SelectedSheets.PrintPreview

End Sub