hier ein anderer Code.

Sub DateiAuswählen1()
 
    'Deklarierung Variable
    Dim Dateiname As Variant
    Dim lz As Long, lq As Long, i As Long
    'Workbook ist ein VBA-Objekt
    Dim wbQuelle As Workbook
    Dim wsQuelle As Worksheet, wsZiel As Worksheet
    Dim arrQB, arrQD
    
     
    Application.ScreenUpdating = False           'Bildschirmaktualisierung ausschalten
    Application.Calculation = xlCalculationManual
     
    'Öffnet Datei-Fenster um Datei auszuwählen
    Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien(*.xls*),*.xls*")
    'Prüfen ob eine Datei ausgewählt wurde
    If Dateiname <> False Then
       Set wbQuelle = Workbooks.Open(Filename:=Dateiname) 'Arbeitsmappe öffnen
       Set wsQuelle = wbQuelle.Worksheets(1)
       lq = wsQuelle.Cells(wsQuelle.Rows.Count, 2).End(xlUp).Row 'Die letzte Zeile der Spalte B bestimmen
     
        arrQB = wsQuelle.Cells(2, 2).Resize(lq - 1) 'Werte aus Spalte b in Array
        arrQD = wsQuelle.Cells(2, 4).Resize(lq - 1) 'Werte aus Spalte D in Array
        wbQuelle.Close SaveChanges:=False           'Quelle schliessen
         
        Set wsZiel = ThisWorkbook.Worksheets("Haupt")
        'Zeilenwert (ab wo eingefügt werden soll) der immer wieder auf 7 zurückgesetzt _
                        wird, damit er wieder ab diesen Zeilenwert einfügt
                
        lz = wsZiel.Cells(wsZiel.Rows.Count, 5).End(xlUp).Row 'erste freie Zeile Spalte E
         
           
        Dim oDict, x As Long
        Set oDict = CreateObject("Scripting.Dictionary")
        For x = 4 To lz
            oDict(wsZiel.Cells(x, 5).Value) = 0
        Next
        
        
        For i = LBound(arrQB) To UBound(arrQB)   'Schleife um die Zeilen des Array der Spalte B zu durchlaufen
             
            If arrQB(i, 1) <> "" Then 'Prüfen ob etwas drinnen steht
                If Not oDict.exists(arrQB(i, 1)) Then
                    lz = lz + 1
                    wsZiel.Cells(lz, "E").Value = arrQB(i, 1) 'werte aus B nach E
                    wsZiel.Cells(lz, "F").Value = arrQD(i, 1) 'werte aus D nach F   
                End If
            End If
                             
        Next i
 
    End If
     
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True        'Bildschirmaktualisierung einschalten
 
End Sub