Moin! Also unter der Annahme, dass deine Tabellen drei verschiedene Tabellenblätter sind (die Karteireiter unten) hätte ich hier eine andere Möglichkeit. Ich gehe zudem mal davon aus, dass die Artikel in Tabelle 1 nur einmal vorkommen - wäre sonst prblematisch, wenn die dann auch in Tabelle 2 sind. Würde dann wohl eine Mehrfacherfassung werden. Die erste Zeile ist anscheinden immer die Überschrift. Die Zusammenfassung wird in einem vierten Blatt eingetragen, dass extra dafür vom Programm angelegt wird. Viele Grüße

Option Explicit

Sub tabellen_verwurschteln()
Dim eins
Dim zwei
Dim drei
Dim neu
Dim ende1 As Long
Dim ende2 As Long
Dim ende3 As Long
Dim zeile As Long
Dim artikel()
Dim i As Long
Dim j As Long
Dim k As Long

Application.ScreenUpdating = False

Set eins = Worksheets(1)
Set zwei = Worksheets(2)
Set drei = Worksheets(3)

Worksheets.Add after:=Worksheets(Worksheets.Count)
Set neu = ActiveSheet
neu.Name = "Zusammenfassung"

neu.Cells(1, 1) = "Artikelnr"
neu.Cells(1, 2) = "Bezeichnung"
neu.Cells(1, 3) = "Karton"
neu.Cells(1, 4) = "xc"
neu.Cells(1, 5) = "Big"

zeile = 2

ende1 = eins.Cells(Rows.Count, 1).End(xlUp).Row
ende2 = zwei.Cells(Rows.Count, 1).End(xlUp).Row
ende3 = drei.Cells(Rows.Count, 1).End(xlUp).Row

ReDim artikel(0)
artikel(0) = 0

For i = 2 To ende1
    If eins.Cells(i, 1) <> "" Then
            artikel(0) = artikel(0) + 1
            ReDim Preserve artikel(artikel(0))
            artikel(artikel(0)) = eins.Cells(i, 1)
            
            If Application.WorksheetFunction.CountIf(zwei.Columns(1), eins.Cells(i, 1)) > 0 Then
                For j = 2 To ende2
                    If zwei.Cells(j, 1) <> "" Then
                        If zwei.Cells(j, 1) = eins.Cells(i, 1) Then
                            neu.Cells(zeile, 1) = eins.Cells(i, 1)
                            neu.Cells(zeile, 2) = eins.Cells(i, 2)
                            neu.Cells(zeile, 3) = zwei.Cells(j, 2)
                            neu.Cells(zeile, 4) = zwei.Cells(j, 3)
                            For k = 1 To ende3
                                If zwei.Cells(j, 2) = drei.Cells(k, 1) Then neu.Cells(zeile, 5) = drei.Cells(k, 3)
                            Next k
                            
                            zeile = zeile + 1
                        End If
                    End If
                Next j
            Else
                neu.Cells(zeile, 1) = eins.Cells(i, 1)
                neu.Cells(zeile, 2) = eins.Cells(i, 2)
                zeile = zeile + 1
            End If
        
    End If
Next i

For i = 2 To ende2
    If zwei.Cells(i, 1) <> "" Then
        If UBound(Filter(artikel, zwei.Cells(i, 1))) > -1 Then
        Else
            neu.Cells(zeile, 1) = zwei.Cells(i, 1)
            neu.Cells(zeile, 3) = zwei.Cells(i, 2)
            neu.Cells(zeile, 4) = zwei.Cells(i, 3)
            For k = 1 To ende3
                If zwei.Cells(i, 2) = drei.Cells(k, 1) Then neu.Cells(zeile, 5) = drei.Cells(k, 3)
            Next k
            zeile = zeile + 1
        End If
    End If
Next i
        
Set eins = Nothing
Set zwei = Nothing
Set drei = Nothing
Set neu = Nothing

Application.ScreenUpdating = True

End Sub