das geht nicht so einfach.
Ich habe den Code jetzt verändert, so dass Du selber beliebige Spalten anpassen kannst.
Schau Dir die Kommentare im Code an, dann wirst Du das System leicht erfassen.
Ich nutze in Tabelle1 die Spalte O als Hilfsspalte. Dort wird temporär eine Formel rein geschrieben und am Ende wieder entfernt!
Code:
Sub zusammenfassen2()
Dim i As Long, j As Long, x As Long
Dim lngZq As Long, lngZz As Long
Dim arr1(), arr2()
Dim feld, feld2
Dim cKey
Dim cO As Object
Set cO = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
lngZq = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("O2:O" & lngZq).FormulaLocal = "=M2&" & """#""" & "&D2&" & """#""" & "&F2&" & """#""" & "&H2"
feld = .Range("A1:N" & lngZq)
feld2 = .Range("O1:O" & lngZq)
.Range("O2:O" & lngZq).ClearContents
End With
For i = 2 To lngZq
cKey = feld(i, 13) & "#" & feld(i, 4) & "#" & feld(i, 6) & "#" & feld(i, 8)
cO(cKey) = cO(cKey) & "|" & feld(i, 1)
Next i
ReDim arr(cO.Count, 5) ' die Zahl gibt die Anzahl der einzulesenden Saplten minus 1 Spalte an
For Each cKey In cO
x = Application.Match(cKey, feld2, 0)
arr(j, 0) = feld(x, 1) 'Artikel-Nr
arr(j, 1) = feld(x, 4) 'Name
arr(j, 2) = feld(x, 5) 'Description
arr(j, 3) = feld(x, 6) 'Marke
arr(j, 4) = Replace(cO(cKey), "|", "", 1, 1) 'Nummern zusammenfassung
arr(j, 5) = feld(x, 14) 'Gewicht
j = j + 1
Next
With Sheets("Tabelle2")
lngZz = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A2:F" & lngZz).ClearContents
.Cells(2, 1).Resize(j, 6).Value = (arr)
End With
End Sub
Das Erweitern ist nun kein Problem.