Hallo Aston,

teste mal so:

Option Explicit
Option Compare Text
 
Const Folder = "D:\Test_Umgebung\Orders_xlsx"
 
Public Sub test2()
     
Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
Dim Datum As Date
Dim num As String
Dim Filename As String
Dim aktDate As Date
Dim Wkb As Workbook, Fso As Object, file As Object, Zeile As Long
Dim Wkb2 As Workbook
Dim test As String
     
aktDate = "17.10.2017"
num = "1"
test = 2
     
With Application
    .ScreenUpdating = False     'Bildschirmaktualisierung aus
    .AskToUpdateLinks = False   'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren
    .DisplayAlerts = False      'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken
End With
       
Set Fso = CreateObject("Scripting.FileSystemObject")    'Dateisystem-Operationen
     
Workbooks.Open "Testo_" & aktDate & "--" & num & ".xlsx"
Set Wkb2 = test & "--" & num & ".xlsx"
  
For Each file In Fso.GetFolder(Folder).Files  'Alle _orders.xlsx-Dateien einlesen und eintragen
    If Fso.GetExtensionName(file.Name) Like "xlsx" And Fso.GetBaseName(file.Name) Like "*orders*" Then
        Set Wkb = GetObject(file.Path)
            With Wkb.Sheets(1) 'Werte mit Zahlenformat werden erst geptrüft
                    'Ich habe getern eine der gössten
                    'Wenn Feld B2 aus dem File orders.xls =
                    'das Datum das beim neuen File eingeben wurde dann coppy Restliche Felder
                    If Wkb.Sheets(1).Range("B2").Value = aktDate Then
                        
                        '### Ermitteln der ersten freien Zelle in Spalte A ###
                        Zeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
                        '### Wenn erste freie Zeile kleiner 3 dann in 3 beginnen ###
                        If Zeile < 3 Then Zeile = 3
                        .Range("A2").Copy:  Cells(Zeile, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("B2").Copy:  Cells(Zeile, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("C2").Copy:  Cells(Zeile, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("D2").Copy:  Cells(Zeile, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("E2").Copy:  Cells(Zeile, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("F2").Copy:  Cells(Zeile, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("G2").Copy:  Cells(Zeile, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("H2").Copy:  Cells(Zeile, "H").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("I2").Copy:  Cells(Zeile, "I").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        .Range("J2").Copy:  Cells(Zeile, "J").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    End If
            End With
        Wkb.Close False
    End If
Next

'####### Wenn du am Anfang abschaltets ######
'####### dann solltest du am Ende auch ######
'####### wieder einschalten            ######
With Application
    .ScreenUpdating = True
    .AskToUpdateLinks = True
    .DisplayAlerts = True
End With
Wkb2.Save
Workbooks.Close
End Sub

Gruß Werner