Option Explicit
 
' Vorgangsweise:
' Alle Daten der Tabelle 'Bestellung' von Saplte A bis H und bis zur letzten
' Daten in Spalte A werden in das Array 'arrBest' eingelesen. Analog alle
' Daten der Tabelle 'Wareneingang' von Saplte A bis C. Die ersten 3 Elemente
' in den beiden Array's werrden vergliche. Wenn gleich, dann wird kopiert.
' Einlesen und Array-Vergleich ist gegenüber anderen Methoden sehr schnell.
 
Sub BestellungWareneingang()
Dim lz As Long, n As Long, x As Long, m As Long, y As Long
Dim arrBest(), arrEing(), arrBestEing(), arrFirma1(), arrFirma2(), arrFirma3(), arrFirma4(), arrFirma5()
Dim objRng  As Range
Dim objWks_B  As Worksheet
Dim objWks_W  As Worksheet
Dim objWks_BW  As Worksheet
Dim objWks_1  As Worksheet
Dim objWks_2  As Worksheet
Dim objWks_3  As Worksheet
Dim objWks_4  As Worksheet
Dim objWks_5  As Worksheet

Set objWks_1 = ThisWorkbook.Worksheets("Firma1")
With objWks_1
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(1, 1), .Cells(lz, 1))
    arrFirma1 = objRng.Value
End With

    
Set objWks_Firma2 = ThisWorkbook.Worksheets("Firma2")
With objWks_Firma2
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(1, 1), .Cells(lz, 1))
    arrFirma2 = objRng.Value
End With

Set objWks_Firma3 = ThisWorkbook.Worksheets("Firma3")
With objWks_Firma3
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(1, 1), .Cells(lz, 1))
    arrFirma3 = objRng.Value
End With

Set objWks_Firma4 = ThisWorkbook.Worksheets("Firma4")
With objWks_Firma4
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(1, 1), .Cells(lz, 1))
    arrFirma4 = objRng.Value
End With

Set objWks_Firma5 = ThisWorkbook.Worksheets("Firma5")
With objWks_Firma5
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(1, 1), .Cells(lz, 1))
    arrFirma5 = objRng.Value
End With

Set objWks_BW = ThisWorkbook.Worksheets("Bestellung+Wareneingang")
m = 2
With objWks_BW
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(2, 1), .Cells(lz, 1))
    arrBestEing = objRng.Value
End With

' **  Bestellung ********************************
'Tabelle mit Daten welche ins Array müssen
Set objWks_B = ThisWorkbook.Worksheets("Bestellungen")
   
With objWks_B
    ' letzte Datenzeile in Tabelle 'Bestellung' der Spalte A
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
       
    'Zellen mit Daten welche ins Array müssen (Spalte A - H, 2 bis letzte Zeile)
    Set objRng = .Range(.Cells(2, 1), .Cells(lz, 3))
     
    'Werte der Zellen in Array schreiben
    arrBest = objRng.Value
End With
' **********************************************
 
 
' **  Lieferung ********************************
Set objWks_W = ThisWorkbook.Worksheets("Wareneingang")
With objWks_W
    lz = .Cells(Rows.Count, "A").End(xlUp).Row
    Set objRng = .Range(.Cells(2, 1), .Cells(lz, 3))
    arrEing = objRng.Value
End With
' **********************************************
 
Application.ScreenUpdating = False
' Eigentliche Suche und vergleichen in den beiden Daten-Array's
For n = 1 To UBound(arrBest)
    For x = 1 To UBound(arrEing)
        If arrBest(n, 1) = arrEing(x, 1) And _
           arrBest(n, 2) = arrEing(x, 2) And _
           arrBest(n, 3) = arrEing(x, 3) Then
           objWks_B.Cells(x + 1, 9) = "Ja"
           objWks_W.Cells(x + 1, 9) = "Ja"
            'Kopiervorgang von 'Bestellungen'und 'Wareneingang' in 'Bestellung+Wareneingang'
            With objWks_BW
                .Range(.Cells(m, 1), .Cells(m, 2)).Value = _
                objWks_B.Range(objWks_B.Cells(n + 1, 1), objWks_B.Cells(n + 1, 2)).Value
                objWks_BW.Cells(m, 3).Value = objWks_W.Cells(n + 1, 8).Value
                .Range(.Cells(m, 4), .Cells(m, 5)).Value = _
                objWks_B.Range(objWks_B.Cells(n + 1, 3), objWks_B.Cells(n + 1, 4)).Value
                objWks_BW.Cells(m, 6).Value = objWks_B.Cells(n + 1, 6).Value
                objWks_BW.Cells(m, 7).Value = objWks_B.Cells(n + 1, 5).Value
                objWks_BW.Cells(m, 8).Value = objWks_W.Cells(n + 1, 5).Value
                .Range(.Cells(m, 9), .Cells(m, 10)).Value = _
                objWks_B.Range(objWks_B.Cells(n + 1, 7), objWks_B.Cells(n + 1, 8)).Value
                objWks_BW.Cells(m, 11).Value = objWks_W.Cells(n + 1, 7).Value
                m = m + 1
            End With
            Exit For
        End If
    Next x
Next n
Application.ScreenUpdating = True

Application.ScreenUpdating = False
For m = 1 To UBound(arrBestEing)
    For y = 1 To UBound(arrFirma1)
        If arrBestEing(m, 1) = arrFirma1(y, 1) Then
            'Kopiervorgang von 'Bestellung+Wareneingang'in 'Firma1'
            With objWks_BW.Cells(y + 2, 2).Value = objWks_1.Cells(m + 1, 1).Value
            End With
            Exit For
        End If
    Next y
Next m
Application.ScreenUpdating = True
 
End Sub

Hab den 1 Teil etwas abgeändert (nicht ausschneiden, sondern nur in die neue Tabelle kopieren)

Jetzt hab ich den 2 Teil versucht umzusetzen (erstmal ohne Sverweis) aber auch das funktioniert schon nicht:D ich kann das einfach nicht