Hallo VBA Gemeinde

Mein Problem ist das ich mit meiner Datei 1 mit dem Vergleichscode aus führe, dann die Dateien die verglichen werden sollen geöffnent werden.

Verglichen wird durch erzeugen zweier Objekte die die jeweiligen Inhalte der speziefischen Sheet enthält.

Mein Problem ist das nur einen Wert ,warscheinlich von der ersten Datei in der das Makro vorhanden ist, in meinem Objekt gespeichert wird.

Die Variable sDateiNamen 1 und 2 wird aus dem geöffnetem Pfad der zwei Vergleichsdateien extrahiert.

Ich danke schon im voraus für eure Hilfe

Hans  

Private Sub Vergleich_Arbeitsmappen()
    'Vergleich von Mappe Y mit Mappe Z
    Dim intWB As Integer, intWS As Integer
    Dim objDic As Object
    Dim regObj As Range
    Dim i As Long
    Dim x As Long
    Dim objDic1 As Object
    Dim objDic2 As Object
    'Dim strCount As String
    'Dim strCount2 As String
    Dim key As Variant
    
    Set objDic1 = CreateObject("scripting.dictionary")
    Set objDic2 = CreateObject("scripting.dictionary")

    '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
 
    'Vergleich der Zellinhalte
    Workbooks(sDateiName1).Worksheets(intWS).Activate
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Workbooks(sDateiName1).Worksheets(intWS).Activate
      If Not objDic1.exists(Cells(i, 1).Value) Then
        objDic1.Add Cells(i, 1).Value, i
      End If
    Next
    
    Workbooks(sDateiName2).Worksheets(1).Activate
    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      If Not objDic2.exists(Cells(x, 1).Value) Then
        objDic2.Add Cells(x, 1).Value, x
      End If
    Next
    
    Debug.Print "Datei 1"
    Debug.Print ""
    For Each key In objDic1.Keys
    Debug.Print key, objDic1(key)
    Next key
    Debug.Print ""
    Debug.Print "Datei 2"
    Debug.Print ""
    For Each key In objDic2.Keys
    Debug.Print key, objDic2(key)
    Next key
    
    Workbooks(sDateiName2).Worksheets(1).Activate
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      If objDic1.exists(ActiveSheet.Cells(i, 1).Value) Then
        Cells(i, 1).Interior.ColorIndex = 4
      Else
        Cells(i, 1).Interior.ColorIndex = 3
      End If
    Next
    
    Workbooks(sDateiName1).Worksheets(1).Activate
    For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      If objDic2.exists(ActiveSheet.Cells(x, 1).Value) Then
        Cells(x, 1).Interior.ColorIndex = 4
      Else
        Cells(x, 1).Interior.ColorIndex = 3
      End If
    Next
  Next
End Sub