Hallo! Also Screenshots wären zum Abgleich, falls es falsch läuft nicht schlecht. Ansonsten hab ich hier mal einen ersten Versuch. Zumindest in meiner Testumgebung funktioniert er. Prüfe mal bitte ob das so hinhaut. Schönen Abend noch

Option Explicit
   
Sub vergleichen()
Dim eins As Object
Dim zwei As Object
Dim drei As Object
Dim vier As Object
Dim ende1 As Long
Dim ende2 As Long
Dim ende3 As Long
Dim ende4 As Long
Dim artikel()
Dim i As Long
Dim j As Long
Dim k As Long
Dim zusammensetzung()
  
Application.ScreenUpdating = False
   
Set eins = Worksheets(1)
Set zwei = Worksheets(2)
Set drei = Worksheets(3)
Set vier = Worksheets(4)
   
ende1 = eins.Cells(Rows.Count, 1).End(xlUp).Row 'belegte Zellen in Blatt 1

ReDim artikel(2, ende1)

For i = 1 To ende1
    If eins.Cells(i, 1) <> "" Then
        artikel(1, i) = eins.Cells(i, 1)
        artikel(2, i) = CLng(eins.Cells(i, 2))
    End If
Next i

ende2 = zwei.Cells(Rows.Count, 1).End(xlUp).Row

ReDim zusammensetzung(ende2, ende1)

For j = 0 To ende1
    For i = 1 To ende2
        If zwei.Cells(i, 1) <> "" Then
            If j = 0 Then
            zusammensetzung(i, 0) = zwei.Cells(i, 1)
            Else
                If artikel(1, j) <> "" Then zusammensetzung(i, j) = Application.WorksheetFunction.CountIf(zwei.Range(zwei.Cells(i, 2), zwei.Cells(i, 10)), artikel(1, j))
            End If
        End If
    Next i
Next j

ende3 = drei.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To ende3
    For j = 1 To ende1
        If drei.Cells(i, 1) = artikel(1, j) Then
            artikel(2, j) = artikel(2, j) + Application.WorksheetFunction.Sum(drei.Range("B:BB").Rows(i))
        End If
    Next j
Next i

ende4 = vier.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To ende4
    For j = 1 To ende2
        If vier.Cells(i, 1) = zusammensetzung(j, 0) Then
            For k = 1 To ende1
                artikel(2, k) = artikel(2, k) - (Application.WorksheetFunction.Sum(vier.Range("B:BB").Rows(i)) * zusammensetzung(j, k))
            Next k
        End If
    Next j
Next i

'Werte wieder eintragen
j = 1
For i = 1 To ende1
    If eins.Cells(i, 1) = artikel(1, j) Then
    
        eins.Cells(i, 2) = artikel(2, j)
        j = j + 1
    End If
Next i

Set eins = Nothing
Set zwei = Nothing
Set drei = Nothing
Set vier = Nothing

Application.ScreenUpdating = True
   
End Sub