Hallo Patrick,
das ist aber keine Datei sondern ein Bild. Das Nachbauen der Datei hast du also jetzt mal großzügigerweise mir überlassen.
Public Sub Test()
Dim loZeile As Long, loLetzte As Long
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1") 'Blattname anpassen
Set wsZiel = ThisWorkbook.Worksheets("Tabelle2") 'Blattname anpassen
loZeile = Selection.Row
loLetzte = wsZiel.Columns(3).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlPrevious).Row
Range(Cells(loZeile, 2), Cells(loZeile, 3)).Copy wsZiel.Cells(loLetzte + 1, 3)
Rows(loZeile).Delete
Set wsQuelle = Nothing: Set wsZiel = Nothing
End Sub
Gruß Werner
|