Letzte beschriebene Zeile ???

Sub Datenuebertragen()
Dim shZiel As Worksheet, shQuelle As Worksheet
Dim lngZeile As Variant
Application.ScreenUpdating = False
Set shQuelle = ThisWorkbook.Sheets("Daten")
Set shZiel = GetObject("C:\gutachten\Daten Kunden.xls").Sheets("Liste")
With shZiel
lngZeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Range("A" & lngZeile) = shQuelle.Range("E13").Value
.Range("B" & lngZeile) = shQuelle.Range("G13").Value
.Range("C" & lngZeile) = shQuelle.Range("D5").Value
.Range("D" & lngZeile) = shQuelle.Range("F11").Value
.Range("E" & lngZeile) = shQuelle.Range("C56").Value
.Range("F" & lngZeile) = shQuelle.Range("C19").Value
.Range("G" & lngZeile) = shQuelle.Range("D19").Value
.Range("H" & lngZeile) = shQuelle.Range("F19").Value
' ... usw.
With .Parent
Windows(.Name).Visible = True
.Close SaveChanges:=True
End With
End With
Application.ScreenUpdating = True
End Sub