ich hoffe das ihr mir weiterhelfen könnt, da ich bei einem Problem nicht weiterkomme.
Und zwar möchte ich aus zwei gleich aufgebauten Tabellenblätter 2 Spalten vergleichen, sind diese identisch so mach nichts, sind sie unterschiedlich so kopiere die Zeile aus dem Tabellenblatt 2 in das Tabellenblatt 1 an die letzte Position.
Als Beispiel:
- Tabellenblatt 1 Spalte B & C Abgleich Tabellenblatt 2 Spalte B & C
- Unterschiedliche Werte in der Zeile so kopiere die komplette Zeile A bis M aus dem Tabellenblatt 2 in das Tabellenblatt 1 unter der letzten befüllten Zeile.
Ich hatte hier schon einen Code im Forum gefunden, der mir 1 Spalte vergleicht, diesen möchte ich am liebsten erweitern, dass er zwei Abfragen macht. Finde leider nicht mehr den Forumseintrag aus dem ich diesen Code habe
Zur Erleichterung:
Sub Vergleich_FAUF_Marko()
Dim zells As Range
Dim x As Long
Dim rng As Range
Dim lastn As Long
Dim lasta As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("FAUF_dump")
Set ws2 = Worksheets("FAUF")
lastn = ws1.Cells(1048576, 2).End(xlUp).Row
lasta = ws2.Cells(1048576, 2).End(xlUp).Row
Set objDic = CreateObject("Scripting.Dictionary")
Dim v, e
With ws2.Range("B2:B" & lasta)
v = .Value
End With
For Each e In v
If Not objDic.Exists(e) Then objDic.Add e, e
Debug.Print e
Next
Set rng = ws1.Range("B2:B" & lastn)
With ws2.Cells.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each zells In rng
lasta2 = ws2.Cells(1048576, 2).End(xlUp).Row
If Not objDic.Exists(zells.Value) Then
ws1.Range("A" & zells.Row & ":" & "N" & zells.Row).Copy ws2.Range("A" & lasta2 + 1)
ws2.Range("A" & lasta2 + 1 & ":" & "N" & lasta2 + 1).Interior.Color = 5296274
End If
Next
End Sub
Ich würde mich sehr über eine Hilfe von euch freuen ;) bis denn Christoph