Ich habe so etwas ähnliches schon programmiert allerdings in einer datei

evtl hilft dir das weiter

Sub Material_auslesen()
Dim MatNr As String
Dim letztezeiletabelle1 As Integer
Dim letztezeiletabelle2 As Integer
Dim T1Zeile As Integer, T2Zeile As Integer
Dim Lagerort As String

letztezeiletabelle1 = Worksheets("MatListe").Cells(1048576, 1).End(xlUp).Row
letztezeiletabelle2 = Worksheets("Ausgabe").Cells(1048576, 1).End(xlUp).Row

'Fehlerbehandlung
On Error GoTo fehler:

'Jede Zeile aus MatListe
For T1Zeile = 1 To letztezeiletabelle1

'letzte Zeile neu ermitteln nach änderung
letztezeiletabelle1 = Worksheets("MatListe").Cells(1048576, 1).End(xlUp).Row
letztezeiletabelle2 = Worksheets("Ausgabe").Cells(1048576, 1).End(xlUp).Row

'Materialnummer erfassen
MatNr = ThisWorkbook.Worksheets("MatListe").Cells(T1Zeile, 1).Value
Lagerort = ThisWorkbook.Worksheets("MatListe").Cells(T1Zeile, 4).Value

'Material in Tabelle2 suchen
'Bei Fund dazuzählen und nächste MatNr nehmen
    'ansonsten komplette MatNr + Bezeichnung + Anzahl in Tabelle2 schreiben
ThisWorkbook.Worksheets("Ausgabe").Select
For T2Zeile = 1 To letztezeiletabelle2
    If Worksheets("Ausgabe").Cells(T2Zeile, 1).Value = MatNr And ThisWorkbook.Worksheets("Ausgabe").Cells(T2Zeile, 4).Value = Lagerort Then
        Cells(T2Zeile, 3).Value = Cells(T2Zeile, 3).Value + ThisWorkbook.Worksheets("MatListe").Range("C" & T1Zeile).Value
        GoTo nächste_MatNr
    End If
Next T2Zeile

'Bei keinem Fund werte komplett unten dran schreiben
Cells(letztezeiletabelle2 + 1, 1).Value = ThisWorkbook.Worksheets("MatListe").Range("A" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 2).Value = ThisWorkbook.Worksheets("MatListe").Range("B" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 3).Value = ThisWorkbook.Worksheets("MatListe").Range("C" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 4).Value = ThisWorkbook.Worksheets("MatListe").Range("D" & T1Zeile).Value
Cells(letztezeiletabelle2 + 1, 5).Value = ThisWorkbook.Worksheets("MatListe").Range("E" & T1Zeile).Value


nächste_MatNr:

Next T1Zeile


Daten_sortieren 'Sortieren

ThisWorkbook.Worksheets("Ausgabe").Range("A1").Select 'Ausgabetabelle auswählen

MsgBox "Datei wurde erfolgreich zusammengefasst!"

Exit Sub

fehler:
MsgBox "Es ist ein Fehler aufgetreten!" & vbCrLf & _
        Err.Number & " " & Err.Description

End Sub