Guten Tag zusammen
Ich habe eine Excel-Datei in welcher ich Bestellungen eintrage und diese dann per Knopfdruck kopiere und in ein anderes Excel-file einfügen möchte. Die neue Bestellung soll dabei immer in die 2. Zeile geschrieben werden. Dazu muss eine neue Zeile eingefügt werde. Solange sich die erste Excel-Datei auf einem Windows 10 System befindet, funktioniert alles einwandfrei, auf einem PC mit Windows 7 klappts jedoch nicht. Das VBA-Skript hängt sich auf und meistens bringt es Excel zum Abstürzen. Wenn Excel nicht abstürzt kommt folgende Fehlermeldung:
Der Debugger markiert mir immer folgende Zeile:
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Ich kann damit aber nichts anfangen, da diese Codezeile sonst immer funktioniert hat. Auch auf Windows 7 Rechnern!
Meine Frage ist nun, wie ich das Skript anpassen kann, damit es auch unter Windows 7 läuft.
Besten Dank für die Hilfe schon Mal im Voraus ;-)
Hier ist der Code:
Sub Bestellen()
'
' Bestellen Makro
'
Dim Marke As String
Sheets("Bestellformular").Select
Marke = Range("E5").Value
'Ü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
'In passendes Tab einfügen
If Marke = "Finn Comfort" Then
Range("C5:K5").Select
Selection.Copy
Workbooks.Open "I:\Domenic Stamm\Bestellung\Bestellformular.xlsm"
Workbooks("Bestellformular.xlsm").Worksheets("New Balance").Select
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:I2").Select
ActiveSheet.Paste
Workbooks("Bestellformular.xlsm").Close SaveChanges:=True
ElseIf Marke = "New Balance" Then
Range("C5:K5").Select
Selection.Copy
Workbooks.Open "I:\Domenic Stamm\Bestellung\Bestellformular.xlsm"
Workbooks("Bestellformular.xlsm").Worksheets("New Balance").Select
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:I2").Select
ActiveSheet.Paste
Workbooks("Bestellformular.xlsm").Close SaveChanges:=True
ElseIf Marke = "FootJoy" Then
Range("C5:K5").Select
Selection.Copy
Workbooks.Open "I:\Domenic Stamm\Bestellung\Bestellformular.xlsm"
Workbooks("Bestellformular.xlsm").Worksheets("FootJoy").Select
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:I2").Select
ActiveSheet.Paste
Workbooks("Bestellformular.xlsm").Close SaveChanges:=True
ElseIf Marke = "Meindl" Then
Range("C5:K5").Select
Selection.Copy
Workbooks.Open "I:\Domenic Stamm\Bestellung\Bestellformular.xlsm"
Workbooks("Bestellformular.xlsm").Worksheets("Meindl").Select
Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2:I2").Select
ActiveSheet.Paste
Workbooks("Bestellformular.xlsm").Close SaveChanges:=True
End If
Sheets("Bestellformular").Select
Range("C5:K5").Select
Selection.ClearContents
End Sub
|