AW: Excel stürzt beim Speichern ab
21.08.2007 13:49:00
Micha
Hi Onkel!
Die Makros habe ich nach bestem Können geschrieben und sie auch überprüft...
hier mal ein Beispiel Makro, dass seine Aufgabe erledigt und wo ich keinen Fehler finde! Aber vielleicht sieht ein Profi ja darin ja etwas "unsauberes"... dann weiss ich z.B. worauf ich auchten muss!!
Sub Auslesen_2()
Dim Bereich(1 To 15) As Range
Dim lngZ As Long 'Zeile in "Bestelleingabe-Kunde"
Application.ScreenUpdating = False
'Prüfung welcher Wert in "J11" in "1blick" eingegeben wurde und Zeilenzahl berechnen
If Worksheets("Lieferschein").Range("J11").Value = 10 Then
lngZ = 10
Else
lngZ = ((Worksheets("Lieferschein").Range("J11").Value - 10) / 10 * 43) + 10
End If
'Kopier- und Einfügecode
With Worksheets("Bestelleingabe-Kunde")
.Activate
'Bereich 1
Set Bereich(1) = .Range(Cells(lngZ + 14, 68), Cells(lngZ + 14, 89))
Bereich(1).Copy
Sheets("Lieferschein").Range("A16").PasteSpecial Paste:=xlPasteValues
'Bereich 2
Set Bereich(2) = .Range(Cells(lngZ + 1, 68), Cells(lngZ + 1, 89))
Bereich(2).Copy
Sheets("Lieferschein").Range("A22").PasteSpecial Paste:=xlPasteValues
'Bereich 3
Set Bereich(3) = .Range(Cells(lngZ + 27, 68), Cells(lngZ + 27, 89))
Bereich(3).Copy
Sheets("Lieferschein").Range("A28").PasteSpecial Paste:=xlPasteValues
'Bereich 4
Set Bereich(4) = .Range(Cells(lngZ + 1, 46), Cells(lngZ + 1, 67))
Bereich(4).Copy
Sheets("Lieferschein").Range("A34").PasteSpecial Paste:=xlPasteValues
'Bereich 5
Set Bereich(5) = .Range(Cells(lngZ + 27, 2), Cells(lngZ + 27, 23))
Bereich(5).Copy
Sheets("Lieferschein").Range("A40").PasteSpecial Paste:=xlPasteValues
'Bereich 6
Set Bereich(6) = .Range(Cells(lngZ + 14, 2), Cells(lngZ + 14, 23))
Bereich(6).Copy
Sheets("Lieferschein").Range("A46").PasteSpecial Paste:=xlPasteValues
'Bereich 7
Set Bereich(7) = .Range(Cells(lngZ + 14, 24), Cells(lngZ + 14, 45))
Bereich(7).Copy
Sheets("Lieferschein").Range("A52").PasteSpecial Paste:=xlPasteValues
'Bereich 8
Set Bereich(8) = .Range(Cells(lngZ + 1, 24), Cells(lngZ + 1, 45))
Bereich(8).Copy
Sheets("Lieferschein").Range("A58").PasteSpecial Paste:=xlPasteValues
'Bereich 9
Set Bereich(9) = .Range(Cells(lngZ + 27, 24), Cells(lngZ + 27, 45))
Bereich(9).Copy
Sheets("Lieferschein").Range("A64").PasteSpecial Paste:=xlPasteValues
'Bereich 10
Set Bereich(10) = .Range(Cells(lngZ + 1, 2), Cells(lngZ + 1, 23))
Bereich(10).Copy
Sheets("Lieferschein").Range("A70").PasteSpecial Paste:=xlPasteValues
'Bereich 11
Set Bereich(11) = .Range(Cells(lngZ + 14, 46), Cells(lngZ + 14, 67))
Bereich(11).Copy
Sheets("Lieferschein").Range("A76").PasteSpecial Paste:=xlPasteValues
'Bereich 12
Set Bereich(12) = .Range(Cells(lngZ + 27, 46), Cells(lngZ + 27, 67))
Bereich(12).Copy
Sheets("Lieferschein").Range("A82").PasteSpecial Paste:=xlPasteValues
'Bereich 13
Set Bereich(13) = .Range(Cells(lngZ - 7, 4), Cells(lngZ - 7, 4))
Bereich(13).Copy
Sheets("Lieferschein").Range("A3").PasteSpecial Paste:=xlPasteValues
'Bereich 14
Set Bereich(14) = .Range(Cells(lngZ - 6, 4), Cells(lngZ - 6, 4))
Bereich(14).Copy
Sheets("Lieferschein").Range("A4").PasteSpecial Paste:=xlPasteValues
'Bereich 15
Set Bereich(15) = .Range(Cells(lngZ - 5, 4), Cells(lngZ - 5, 4))
Bereich(15).Copy
Sheets("Lieferschein").Range("A6").PasteSpecial Paste:=xlPasteValues
End With
Set Bereich1 = Nothing
Set Bereich2 = Nothing
Set Bereich3 = Nothing
Set Bereich4 = Nothing
Set Bereich5 = Nothing
Set Bereich6 = Nothing
Set Bereich7 = Nothing
Set Bereich8 = Nothing
Set Bereich9 = Nothing
Set Bereich10 = Nothing
Set Bereich11 = Nothing
Set Bereich12 = Nothing
Set Bereich13 = Nothing
Set Bereich14 = Nothing
Set Bereich15 = Nothing
Sheets("Lieferschein").Activate
Application.Run "standardwochenplan.xlsm!Lieferschein_Vereinfachen"
Application.ScreenUpdating = True
End Sub
Gruss, Micha