|
Hallo Fabi,
teste mal:
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") 'Blattname anpassen
Set wsZiel = Workbooks("Datei Z.xlsb").Worksheets("Tabelle1") 'Blattname anpassen
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
Der Code gehört in ein allgemeines Modul deiner Datei A, beide Dateien müssen geöffnet sein.
Gruß Werner
|