Danke für die schnelle Antwort 

Hab schon eine andere Lösung gefunden

Habe mich erst mal für den reinen Vergleich zweier Excel dateien konzentriert.

Mein nächter Schritt ist dann .txt datein einzubinden.

Option Explicit

    Dim PfadName1 As Variant
    Dim PfadName2 As Variant
    Dim sDateiName1 As String
    Dim sDateiName2 As String
    Dim bDateiNum1 As Byte
    Dim bDateiNum2 As Byte
    Dim wb1 As Workbook
    Dim wb2 As Workbook

Private Sub CommandButton1_Click()

    Call GetOpen_FileName
    Call Vergleich_Faerbung

    
End Sub

Private Sub GetOpen_FileName()
    
    Dim i As Long
    Dim n As Long
    Dim x As Long
    Dim intWS As Byte
    Dim lName1 As Long
    Dim lName2 As Long
    
    MsgBox "Wählen Sie die beiden Exceltabellen die Verglichen werden sollen.", vbQuestion & vbOKOnly, "Info"
    ChDrive "S"
    ChDir "S:\Projekte"
          
    PfadName1 = Application.GetOpenFilename("Excel-Dateien (*.xl??), *.xl??", Title:="Bitte Exceldatei auswählen", MultiSelect:=False)
    'Extraktion des Mappennamen
    If Not PfadName1 = False Then
      Workbooks.Open PfadName1
      PfadName1 = Mid$(PfadName1, InStrRev(PfadName1, "\") + 1)
      x = (InStrRev(CStr(PfadName1), ".") - 1)
      lName1 = Len(PfadName1) - (Len(PfadName1) - x)
      sDateiName1 = Left(PfadName1, lName1)
      'MsgBox (sDateiName1)
    Else
      Exit Sub
    End If
    
    Workbooks(sDateiName1).Worksheets(1).Range("A:A").Select
    Selection.Copy
    Windows("Vergleich_Excel.xlsm").Activate
    Columns("A:A").Select
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit
    Application.CutCopyMode = False
    
    PfadName2 = Application.GetOpenFilename("Excel-Dateien (*.xl??), *.xl??", Title:="Bitte die Vergleichsdatei auswählen", MultiSelect:=False)
    
    If Not PfadName2 = False Then
      Workbooks.Open PfadName2
      PfadName2 = Mid$(PfadName2, InStrRev(PfadName2, "\") + 1)
      i = (InStrRev(CStr(PfadName2), ".") - 1)
      lName2 = Len(PfadName2) - (Len(PfadName2) - i)
      sDateiName2 = Left(PfadName2, lName2)
      'MsgBox (sDateiName2)
    Else
      Exit Sub
    End If
    
    Workbooks(sDateiName2).Worksheets(1).Range("A:A").Select
    Selection.Copy
    Windows("Vergleich_Excel.xlsm").Activate
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("B:B").EntireColumn.AutoFit
    Application.CutCopyMode = False
    
    'Vergleich Anzahl der Tabellenblätter
    If Workbooks(sDateiName1).Worksheets.Count <> Workbooks(sDateiName2).Worksheets.Count Then
      MsgBox "Die Anzahl der Tabellenblätter ist unterschiedlich!"
    End If

    'Vergleich der benutzen Zellen
    For intWS = 1 To Workbooks(sDateiName1).Worksheets.Count
      If Workbooks(sDateiName1).Worksheets(intWS).UsedRange.Cells.Count <> Workbooks(sDateiName2).Worksheets(intWS).UsedRange.Cells.Count Then
        MsgBox "Die Anzahl der benutzen Zellen in Blatt " & intWS & " " & "ist unterschiedlich!"
      End If
    Next intWS
       
End Sub

Sub Vergleich_Faerbung()

    Dim i As Long
    Dim x As Long
    Dim k As Long
    Dim n As Long
    Dim objDic1 As Object
    Dim objDic2 As Object
    Dim strCount1 As String
    Dim strCount2 As String
    
    Set objDic1 = CreateObject("scripting.dictionary")
    Set objDic2 = CreateObject("scripting.dictionary")
    
    strCount1 = Cells(Rows.Count, 1).End(xlUp).Row
    strCount2 = Cells(Rows.Count, 2).End(xlUp).Row
    
    If PfadName1 Or PfadName2 = False Then
      Exit Sub
    Else
    
    Workbooks(sDateiName1).Close SaveChanges:=False
    Workbooks(sDateiName2).Close SaveChanges:=False

    'Importieren von Zellen aus Workbook(1) in Dictionary 1
    For i = 1 To strCount1
      If Not objDic1.exists(Cells(i, 1).Value) Then
        objDic1.Add Cells(i, 1).Value, i
      End If
    Next
    
    'Importieren von Zellen aus Workbook(2) in Dictionary 2
    For x = 1 To strCount2
      If Not objDic2.exists(Cells(x, 2).Value) Then
        objDic2.Add Cells(x, 2).Value, x
      End If
    Next
    
    'Abfrage ob in aus WB2 ind dictionary 1 vorhanden
    For k = 1 To strCount2
      If objDic1.exists(ActiveSheet.Cells(k, 2).Value) Then
        Cells(k, 2).Interior.ColorIndex = 4
      Else
        Cells(i, 2).Interior.ColorIndex = 3
      End If
    Next
    
    'Abfrage ob in aus WB1 ind Dictionary 2 vorhanden
    For n = 1 To strCount1
      If objDic2.exists(ActiveSheet.Cells(n, 1).Value) Then
        Cells(n, 1).Interior.ColorIndex = 4
      Else
        Cells(n, 1).Interior.ColorIndex = 3
      End If
    Next
    
    'Debug.Print "Spalte 1"
    'Debug.Print ""
    'For Each key In objDic1.Keys
    'Debug.Print key, objDic1(key)
    'Next key
    'Debug.Print ""
    'Debug.Print "Spalte 2"
    'Debug.Print ""
    'For Each key In objDic2.Keys
    'Debug.Print key, objDic2(key)
    'Next key
    
    End If
End Sub