|
Hi Novus,
das klingt ein wenig so, als ob Du den Code selbst nicht wirklich verstehst. Dies wäre allerdings wichtig, hinterher macht das Makro lauter Unsinn und Du merkst es erst nach ein paar Wochen :D
Hier ist auf jeden Fall der angepasste Code (er löscht anstatt auszuschneiden):
Sub VergleichTabellen()
Zeile3 = 1
For Zeile1 = 1 To Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
For Zeile2 = 1 To Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
If Sheets("Tabelle1").Cells(Zeile1, 1) = Sheets("Tabelle2").Cells(Zeile2, 1) Then
Sheets("Tabelle3").Cells(Zeile3, 1) = Sheets("Tabelle1").Cells(Zeile1, 1)
Sheets("Tabelle1").Cells(Zeile1, 1).ClearContents
Sheets("Tabelle3").Cells(Zeile3, 2) = Sheets("Tabelle1").Cells(Zeile1, 2)
Sheets("Tabelle1").Cells(Zeile1, 2).ClearContents
Sheets("Tabelle3").Cells(Zeile3, 3) = Sheets("Tabelle2").Cells(Zeile2, 2)
Sheets("Tabelle2").Cells(Zeile2, 2).ClearContents
Zeile3 = Zeile3 + 1
Exit For
End If
Next Zeile2
Next Zeile1
End Sub
Hier wäre der Code, falls Du es doch ausschneiden und einfügen willst:
Cells(1, 1).Cut
ActiveSheet.Paste Destination:=Cells(1, 2)
lg Y
|