Sub Ruecklaufquote()

Dim wbQuelle1 As Workbook 
Dim wbQuelle2 As Workbook

Datei = Application.GetOpenFilename("Excel, *.xls*") 
If LCase(Datei) Like "fal*" Then Exit Sub

Set wbQuelle1 = Workbooks.Open(Datei, ReadOnly:=True)

wbQuelle1.Activate 'ausgewählte Monitoringauswahl öffnen 
Columns("A:BA").Select 'Zeilen A-BA auswählen 
Selection.Copy 'Auswahl kopieren 
ThisWorkbook.Activate 'Vorlagendatei öffnen 
Sheets(1).Select 'Reiter 2 aktivieren 
Columns("A:A").Select 'Spalte A anwählen 
ActiveSheet.Paste 'Auswahl einfügen 
Application.CutCopyMode = False 'Auswahl aufheben 
wbQuelle1.Close 'Monitoringauswahl schließen

ThisWorkbook.Activate 
Sheets.Add After:=Sheets(Sheets.Count) 'neuen Reiter anlegen

Datei = Application.GetOpenFilename("Excel, *.xls*") 
If LCase(Datei) Like "fal*" Then Exit Sub

Set wbQuelle2 = Workbooks.Open(Datei, ReadOnly:=True)

wbQuelle2.Activate 'ausgewählte Kopfliste öffnen 
Columns("A:Z").Select 'Zeilen A-Z auswählen 
Selection.Copy 'Auswahl kopieren 
ThisWorkbook.Activate 'Monitoringauswertung öffnen 
Sheets(2).Select 'Reiter 2 aktivieren 
Columns("A:A").Select 'Spalte A anwählen 
ActiveSheet.Paste 'Auswahl einfügen 
Application.CutCopyMode = False 'Auswahl aufheben 
wbQuelle2.Close 'Kopfliste schließen

'---=== Dublettenprüfung ===---

Sheets(1).Select

Range("AZ1").Select 
ActiveCell.Formula = "=COUNTA(U2:U10000)" 'Zählen der Monitoringdaten in Spalten U 
Range("AZ1").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 'Wert in AZ1 mittels Wert einfügen fixieren 
Columns("A:AX").Select 
Application.CutCopyMode = False 
ActiveSheet.Range("$A$1:$AX$10000").RemoveDuplicates Columns:=Array(6, 7, 8, 20) _ 
, Header:=xlYes 'Dublettenprüfung in auf Basis Spalten 6,7,8,21 
Range("AZ2").Select 
ActiveCell.Formula = "=COUNTA(U2:U10000)" 'Zählen der Monitoringdaten in Spalten U nach Dublettenbereinigung 
Range("AZ2").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 'Wert in AZ2 mittels Wert einfügen fixieren 
Columns("A:AX").Select 
Application.CutCopyMode = False

Sheets(2).Select

Range("G1").Select 
ActiveCell.Formula = "=COUNTA(D2:D10000)" 'Zählen der Kopfdaten in Spalten D 
Range("G1").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 'Wert in G1 mittels Wert einfügen fixieren 
Columns("A:D").Select 
Application.CutCopyMode = False 
ActiveSheet.Range("$A$1:$D$10000").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _ 
, Header:=xlYes 'Dublettenprüfung in auf Basis Spalten 1,2,3,4 
Range("G2").Select 
ActiveCell.Formula = "=COUNTA(D2:D10000)" 'Zählen der Kopfdaten in Spalten D nach Dublettenbereinigung 
Range("G2").Select 
Selection.Copy 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 'Wert in G2 mittels Wert einfügen fixieren 
Columns("A:D").Select 
Application.CutCopyMode = False

'---===Tabellenabgleich===--- 
'??? 
'SVERWEIS???

End Sub