|  
                                             
	Hallo, 
	bei mir geht es (allerdings auch Win10).  
	Falls Du nur Werte kopieren möchtest, kannst Du das auch ohne Select und Kopie machen. Und Du könntest Deinen Code deutlich verkleinern. 
	  
	Zum Einfügen gibt es auc mindestens zwei Varianten, s. Code. 
	  
	Probiere es halt mal aus. 
Option Explicit
Sub Bestellen()
'
' Bestellen Makro
'
 Dim Marke As String
 Dim WSh As Worksheet, WKb As Workbook
 
 With ThisWorkbook.Sheets("Bestellformular")
'Überprüfen ob Zellen ausgefüllt sind
   If IsEmpty(.Range("C5")) Then
       MsgBox ("Bitte Anzahl einfügen!")
       Exit Sub
   ElseIf IsEmpty(.Range("D5")) Then
       MsgBox ("Bitte Einheit einfügen!")
       Exit Sub
   ElseIf IsEmpty(.Range("E5")) Then
       MsgBox ("Bitte Marke einfügen!")
       Exit Sub
   ElseIf IsEmpty(.Range("F5")) Then
       MsgBox ("Bitte Model einfügen!")
       Exit Sub
   ElseIf IsEmpty(.Range("I5")) Then
       MsgBox ("Bitte Visum einfügen!")
       Exit Sub
   ElseIf IsEmpty(.Range("K5")) Then
       MsgBox ("Bitte Standort einfügen!")
       Exit Sub
   End If
 
   Marke = .Range("E5").Value
 
'In passendes Tab einfügen
 
   If InStr("Finn Comfort,New Balance,FootJoy,Meindl", Marke) > 0 Then
  
'Zieldatei öffnen
      Set WKb = Workbooks.Open("I:\Domenic Stamm\Bestellung\Bestellformular.xlsm")
      Set WSh = WKb.Worksheets(Marke)
'      WSh.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      WSh.Range("A2").EntireRow.Insert
      WSh.Range("A2").Resize(1, 9).Value = .Range("C5:K5").Value
      WKb.Close SaveChanges:=True
      .Range("C5:K5").ClearContents         'Nur löschen bei gültger Marke
    End If
 
 End With
 
End Sub
	viele Grüße 
	Karl-Heinz 
     |