Sub Zuordnung()

    Dim Suche, rngCopyA As Range, i&, cnt&, x&
    
    ' man kanns auch mit den Variablen übertreiben.....

    Anz_Spalten = 3
    
    'beispielhaft Range zu Array
    Suche = Worksheets("Tabelle2").Range("A1:A500")
       
    Set A = Worksheets("Tabelle1")
    Set B = Worksheets("Tabelle4")
    lrowB = B.Cells(Rows.Count, 1).End(xlUp).row
            
    For i = lbound(Suche) To UBound(Suche)
        
        For cnt = 1 To A.Cells(Rows.Count, 1).End(xlUp).row
            
            If Suche(i,1) = A.Cells(cnt, 1).Value Then
                Set rngCopyA = A.Cells(cnt, 2).Resize(1, Anz_Spalten)
                
                For x = 1 To lrowB
                   If Suche(i,1) = B.Cells(x, 1).Value Then
                        B.Cells(x, "C").Resize(1, Anz_Spalten).Value = rngCopyA.Value
                   End If
                Next
           End If
       Next
    Next
    
End Sub