Sub DateiAuswählen1()
Dim Dateiname As Variant
Dim lz As Long, lq As Long, i As Long
Dim wbQuelle As Workbook
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Dim arrQB, arrQD
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien(*.xls*),*.xls*")
If Dateiname <> False Then
Set wbQuelle = Workbooks.Open(Filename:=Dateiname)
Set wsQuelle = wbQuelle.Worksheets(1)
lq = wsQuelle.Cells(wsQuelle.Rows.Count, 2).End(xlUp).Row
arrQB = wsQuelle.Cells(2, 2).Resize(lq - 2)
arrQD = wsQuelle.Cells(2, 4).Resize(lq - 2)
wbQuelle.Close SaveChanges:=False
Set wsZiel = ThisWorkbook.Worksheets("Haupt")
wird, damit er wieder ab diesen Zeilenwert einfügt
lz = wsZiel.Cells(wsZiel.Rows.Count, 5).End(xlUp).Row + 1
For i = LBound(arrQB) To UBound(arrQB)
If arrQB(i, 1) <> "" Then
wsZiel.Cells(lz, "E").Value = arrQB(i, 1)
wsZiel.Cells(lz, "F").Value = arrQD(i, 1)
lz = lz + 1
End If
Next i
wsZiel.UsedRange.RemoveDuplicates Columns:=5, Header:=xlYes
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub