|
Guten Tag in die Runde,
das untenstehende Makro soll jeweils zwei Spalten miteinander vergleichen und bei einem Unterschied der Spalten, die gesamte betroffene Zeile kopieren und farblich markiert einfügen. Das Erkennen der Unterschiede in den Spalten und das Kopieren der Zeile funktionieren einwandfrei, allerdings werden die Zeilen, welche kopiert werden sollen, alle am Ende der Tabelle angefügt. Die kopierten Zeilen sollen aber jeweils direkt unter die zu kopierende Zeile eingefügt werden. Also wenn bspw. die Zeilen 15 und 43 kopiert werden müssten, dann soll das Makro die Zeile 15 kopieren und als neue Zeile 16 in die Tabelle einfügen. Das Gleiche soll in diesem Beispiel mit der Zeile 43 als neue Zeile 44 geschehen. Ich hoffe, dass ich das Problem anschaulich erklären konnte.
Hat vielleicht jemand eine Idee, wie man das lösen kann? Ich habe es schon etliche Stunden versucht, aber bekomme es leider nicht hin. Bin absoluter Anfänger, was das Programmieren angeht.
Über jede Hilfe wäre ich sehr dankbar!
Gruß
Tommy
Sub vergleicheSpalten()
'Variablen definieren
Dim i As Long
Dim last As Long
Dim neu As Long
Dim obj_wks As Worksheet
'Werte zuweisen
Set obj_wks = ActiveSheet
last = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
neu = last + 1
With obj_wks
For i = 2 To last
If Len(.Cells(i, 12)) > 1 Then
If (.Cells(i, 5) <> .Cells(i, 12)) Or (.Cells(i, 6) <> .Cells(i, 13)) Then
.Rows(i).Copy Cells(neu, 1)
.Range("A" & neu & ":R" & neu).Interior.ColorIndex = 6
neu = neu + 1
End If
End If
Next
End With
End Sub
|