Ik ben het helemaal eens met Veerj. Je hebt verkeerdelijk gekozen voor het visuele ipv functionele.
Laat ons hier al eens mee beginnen.
Private dic As Object
Sub tst()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
sn = Sheets("Lijst").ListObjects("tblBestellingen").DataBodyRange.Value
For i = 1 To UBound(sn)
If Not dic.exists(sn(i, 1)) Then Set dic(sn(i, 1)) = CreateObject("scripting.dictionary")
dic(sn(i, 1))(sn(i, 2)) = sn(i, 3)
Next
For i = 0 To dic.Count - 1
With Sheets("Bestellingen")
With .Range(.Range("A1:G20").Find(dic.keys()(i)).Address)
.Offset(1).Resize(dic(dic.keys()(i)).Count) = Application.Transpose(dic(dic.keys()(i)).keys)
.Offset(1, 1).Resize(dic(dic.keys()(i)).Count) = Application.Transpose(dic(dic.keys()(i)).items)
End With
End With
Next
End Sub