Public
Sub
Kopieren()
Dim
loErste as
Long
, loLetzteQuelle
As
Long
, loLetzteZiel
As
Long
Dim
wsQuelle
As
Worksheet, wsZiel
As
Worksheet
Set
wsQuelle = ThisWorkbook.Worksheets(
"Tabelle1"
)
Set
wsZiel = Workbooks(
"Datei Z.xlsb"
).Worksheets(
"Tabelle1"
)
loLetzteQuelle = wsQuelle.Cells(wsQuelle.Rows.Count, 26).
End
(xlUp).Row
loLetzteZiel = wsZiel.Cells(wsZiel.Rows.Count, 2).
End
(xlUp).Row + 1
Application.ScreenUpdating =
False
Application.Calculation = xlCalculationManual
With
wsQuelle
On
Error
GoTo
errorhandler
loErste = WorksheetFunction.Match(
"new"
, .Range(
"Z:Z"
), 0)
.Range(.Cells(loErste, 23), .Cells(loLetzteQuelle, 23)).Copy
wsZiel.Cells(loLetzteZiel, 2).PasteSpecial Paste:=xlValues
.Range(.Cells(loErste, 8), .Cells(loLetzteQuelle, 8)).Copy
wsZiel.Cells(loLetzteZiel, 9).PasteSpecial Paste:=xlValues
Application.CutCopyMode =
False
End
With
Set
wsQuelle =
Nothing
:
Set
wsZiel =
Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating =
True
Exit
Sub
errorhandler:
On
Error
GoTo
0
MsgBox
"Keine neuen Aufträge vorhanden."
Set
wsQuelle =
Nothing
:
Set
wsZiel =
Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating =
True
End
Sub