VBA Spalten vergleichen fehlende einträge übertrag
25.01.2018 14:04:04
Sabrina
ich bin gerade an einem Code dran.
Ich habe eine Datei mit drei Tabellenblätter.
Zuerst versuche ich alle Wörter in beiden Blättern ins Dritte Tabellenblatt zu kopieren und in Spalte H einzutragen Dann lösche ich alle Duplikate.
Jetzt möchte ich die Wörter in Spalte H mit denen aus Spalte A zu vergleichen.
Alle wörter in H die es noch nicht in A gibt sollen in A hinzugefügt werden. Sollte in A Wörter sein die in H nicht gibt so sollen diese Rot makiert werden.Vorab schon mal vielen Dank für eure Hilfe
Hier den Code wie ich ihn bis jetzt habe:
Sub aktualisieren()
Dim zelle As Range
Dim a As Long
a = 2
Application.ScreenUpdating = False
With Worksheets("Deckblatt")
For Each zelle In .Range("A1:AH100")
If zelle > 0 Then
zelle.Copy
Worksheets("Übersetzung").Select
Cells(a, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
a = a + 1
End If
Next
End With
With Worksheets("Testergebnisse")
For Each zelle In .Range("A1:AH100")
If zelle > 0 Then
zelle.Copy
Worksheets("Übersetzung").Select
Cells(a, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
a = a + 1
End If
Next
End With
ActiveSheet.Range("H:H").RemoveDuplicates Columns:=1, Header:=xlNo
'Dim lezeile As Variant
'Range("A:A,H:H").Select
'Selection.RowDifferences(ActiveCell).Select
'Selection.Copy
'lezeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
'Cells(lezeile, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
'Range("H2:H500").ClearContents
Worksheets("Übersetzung").Cells(1, 1).Select
End Sub