Guten Tag zusammen. Habe hier im Forum einen VB-Code gefunden der annähernd meiner Vorstellung für einen Datenabgleich entspräche. Ich möchte von Datei1.xlsm ungleiche Zelleninhalte nach Datei2.slsx (Werte o. ggf. Text) kopieren. Die Tabellen sollen von Spalte "A...." bis Spalte "K...." abgeglichen, und unpaarige Inhalte von Datei1 nach Datei2 in die gleiche Zelle eingefügt werden. Dabei kann es eine leere wie aber auch eine inhaltlich anderer Wert sein, der korrigiert werden müsste. Hänge mal mein Beispiel hier an. Danke und Gruß
Sub Daten_prüfen()
Dim iDat1 As Long, iDat2 As Long, firstRow As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Application.ScreenUpdating = False
Set wks1 = Workbooks("Datei1.xlsm").Sheets("Tabelle1")
Set wks2 = Workbooks("Datei2.xlsx").Sheets("Tabelle1")
For iDat1 = 11 To wks1.Range("A65").End(xlUp).Row
For iDat2 = 11 To wks2.Range("A65").End(xlUp).Row
If wks1.Cells(iDat1, 4) <> wks2.Cells(iDat2, 4) Then
' wks2.Cells(iDat2, 4) = wks1.Cells(iDat1, 4)
GoTo Weiter
End If
Next
firstRow = wks2.Range("B65").End(xlUp).Offset(1, 0).Row
With wks2
.Cells(firstRow, 4) = wks1.Cells(iDat1, 4)
.Cells(firstRow, 4) = wks1.Cells(iDat1, 4)
.Cells(firstRow, 4).Font.ColorIndex = 3
.Cells(firstRow, 4).Font.Bold = True
End With
Weiter:
Next
End Sub
Beispiel