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
|