Set Destination = Workbooks.Open("C:\Desktop\Auswertung.xls")
Set NewSheet = Destination.Worksheets(1) Worksheets(1).Select
Dim Counter As Integer
Counter = 1 Do
If Cells(Counter, 1) = "" Then
If Cells(Counter + 1, 1) = "" Then
Counter = Counter + 1
Exit Do
End If
End If
Counter = Counter + 1
Loop
Dim newrange As Range
Set newrange = NewSheet.Range(Cells(Counter + 1, 1), Cells(Counter + 1, 1))
newrange.PasteSpecial Paste:=xlPasteValues
Destination.Save
Destination.Close
Sheets("Auswertung").Select
Range("A1").Select
MsgBox "Auswertung erfolgreich!"