Excel Makro (VBA) Datenübertragung von Tabelle 1 zu Tabelle 2

Sub Werte_Zuordnen()
    Dim dic As Object, wsSource As Worksheet, wsTarget As Worksheet, rngDataStart As Range, rngDataEnd As Range, rngTargetStart As Range, rngTargetEnd As Range, cell As Range
    
    'Dictionary Object das die Zuordnung der Daten der ersten Tabelle enthält  
    Set dic = CreateObject("Scripting.Dictionary")  
    
    'Worksheets referenzieren  
    Set wsSource = Worksheets(1)
    Set wsTarget = Worksheets(2)
    
    'Referenzbereich der ersten Tabelle festlegen  
    Set rngDataStart = wsSource.Range("A2")  
    Set rngDataEnd = rngDataStart.End(xlDown)
    
    'Zielbereich der zweiten Tabelle  
    Set rngTargetStart = wsTarget.Range("A2")  
    Set rngTargetEnd = wsTarget.Cells(Rows.Count, 1).End(xlUp)
    
    'Dictionary mit den Werten der ersten Tabelle füllen  
    For Each cell In wsSource.Range(rngDataStart, rngDataEnd)
        dic.Add cell.Value, cell.Offset(0, 1).Value
    Next
    
    'Zieltabelle durchgehen und Werte zuordnen  
    For Each cell In wsTarget.Range(rngTargetStart, rngTargetEnd)
        ' Wenn Wert der Zelle nicht leer ist und der Wert in der Zuordnungstabelle vorhanden ist dann schreibe den Wert in die Zelle daneben  
        If cell.Value <> "" And dic.Exists(cell.Value) Then  
            cell.Offset(0, 1).Value = dic.Item(cell.Value)
        End If
    Next
End Sub