Hallo Erich,
du hast Recht - mit einer neutralen Datei funktioniert das Programm.
es funktioniert auch wenn stkList bereits geöffnet ist
In dere Datei stkList befinden sich Makros
kann es trotzdem funktionieren
Public m2, anzZu As Long
Public dek As String
Option Explicit
Sub raus()
Dim aktWkb, stkList, wkCSV, holzList As Worksheet
Dim d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, listBu, dek1, verglBu, spName As String
Dim n, i, L As Long
Dim spName1
Application.ScreenUpdating = False
spName1 = "stkListKopie" & Date & " Zeit " & Hour(Time) & "h" & Minute(Time) & "M" & Second( _
Time)
ActiveWorkbook.SaveCopyAs "z:\Dekore\stkListSich\" & (spName1)
Set stkList = Workbooks("stkList").Sheets("stk")
Set wkCSV = Workbooks("stkList").Sheets("csv")
dek1 = wkCSV.Range("A5")
listBu = UCase(wkCSV.Range("G6"))
spName = dek1 & "D" & Date & " Zeit " & Hour(Time) & "h" & Minute(Time)
d1 = -3: d2 = -4: d3 = -8: d4 = -16: d5 = -19: d6 = -28: d7 = -38: d8 = -56: d9 = -10: d10 = - _
12: d11 = -25: d12 = -32: anzZu = 0
Workbooks.Open "c:\Optimierung\csvListe.xls"
Workbooks("csvListe.xls").Activate
ActiveWorkbook.SaveAs Filename:="C:\Optimierung\optXLS\" & spName, _
CreateBackup:=False
Set aktWkb = ActiveWorkbook.Worksheets("Tabelle1")
For n = 0 To 11
wkCSV.Activate
Range("C5").Activate
d1 = ActiveCell.Offset(0, n)
dek = dek1 & "-" & d1: m2 = 0: anzZu = 0
stkList.Activate
For L = 2 To stkList.UsedRange.Rows.Count
If stkList.Cells(L, 7) Like dek Then
If listBu = "" Or Not Right(dek, 2) = "19" Then
i = 2
'Eintrag
Do Until aktWkb.Cells(i, 1) = ""
i = i + 1
Loop
aktWkb.Cells(i, 1).Value = stkList.Cells(L, 1)
aktWkb.Cells(i, 2).Value = stkList.Cells(L, 2)
aktWkb.Cells(i, 3).Value = Round(stkList.Cells(L, 3) + 0.001)
aktWkb.Cells(i, 4).Value = Round(stkList.Cells(L, 4) + 0.001)
aktWkb.Cells(i, 5).Value = stkList.Cells(L, 5)
aktWkb.Cells(i, 6).Value = stkList.Cells(L, 6)
aktWkb.Cells(i, 7).Value = stkList.Cells(L, 7)
aktWkb.Cells(i, 8).Value = stkList.Cells(L, 8)
aktWkb.Cells(i, 9).Value = stkList.Cells(L, 9)
aktWkb.Cells(i, 10).Value = stkList.Cells(L, 10)
'Stat
m2 = m2 + stkList.Cells(L, 2) * stkList.Cells(L, 3) / 1000 * stkList.Cells(L, 4) / 1000
anzZu = anzZu + stkList.Cells(L, 2)
stkList.Rows(L).Delete Shift:=xlUp
L = L - 1
Else
verglBu = ("*" & UCase(Left(stkList.Cells(L, 6), 1)) & "*")
If Right(dek, 2) = "19" Then
If listBu Like verglBu Then
i = 2
'Eintrag
Do Until aktWkb.Cells(i, 1) = ""
i = i + 1
Loop
aktWkb.Cells(i, 1).Value = stkList.Cells(L, 1)
aktWkb.Cells(i, 2).Value = stkList.Cells(L, 2)
aktWkb.Cells(i, 3).Value = Round(stkList.Cells(L, 3) + 0.001)
aktWkb.Cells(i, 4).Value = Round(stkList.Cells(L, 4) + 0.001)
aktWkb.Cells(i, 5).Value = stkList.Cells(L, 5)
aktWkb.Cells(i, 6).Value = stkList.Cells(L, 6)
aktWkb.Cells(i, 7).Value = stkList.Cells(L, 7)
aktWkb.Cells(i, 8).Value = stkList.Cells(L, 8)
aktWkb.Cells(i, 9).Value = stkList.Cells(L, 9)
aktWkb.Cells(i, 10).Value = stkList.Cells(L, 10)
'Stat
m2 = m2 + stkList.Cells(L, 2) * stkList.Cells(L, 3) / 1000 * stkList.Cells(L, 4) _
/ 1000
anzZu = anzZu + stkList.Cells(L, 2)
stkList.Rows(L).Delete Shift:=xlUp
L = L - 1
End If
End If
End If
End If
Next L
'eintrag für Statistik
If anzZu > 0 Then
mkStat
End If
Next n
'speichern unter xls und csv
aktWkb.Activate
'Holz- und Aluleisten rausschreiben
Set holzList = ActiveWorkbook.Worksheets("druck")
i = 1
For n = 2 To aktWkb.UsedRange.Rows.Count
If Left(aktWkb.Cells(n, 8), 1) = "L" Or Left(aktWkb.Cells(n, 8), 1) = "R" Or Left(aktWkb.Cells( _
n, 8), 1) = "M" Or Left(aktWkb.Cells(n, 8), 1) = "G" _
Or Left(aktWkb.Cells(n, 8), 1) = "S" Or Left(aktWkb.Cells(n, 8), 1) = "F" Or Left(aktWkb.Cells( _
n, 8), 1) = "D" Or Left(aktWkb.Cells(n, 8), 1) = "H" _
Or Left(aktWkb.Cells(n, 8), 1) = "I" Or Left(aktWkb.Cells(n, 8), 1) = "Z" Then
'Eintrag
Do Until holzList.Cells(i, 1) = ""
Loop
' holzList.Cells(i, 1).Value = aktWkb.Cells(n, 1)
holzList.Cells(i, 2).Value = aktWkb.Cells(n, 2)
holzList.Cells(i, 3).Value = aktWkb.Cells(n, 3)
holzList.Cells(i, 4).Value = aktWkb.Cells(n, 4)
holzList.Cells(i, 5).Value = aktWkb.Cells(n, 5)
holzList.Cells(i, 6).Value = aktWkb.Cells(n, 6)
holzList.Cells(i, 7).Value = aktWkb.Cells(n, 7)
holzList.Cells(i, 8).Value = aktWkb.Cells(n, 8)
holzList.Cells(i, 9).Value = aktWkb.Cells(n, 9)
holzList.Cells(i, 10).Value = aktWkb.Cells(n, 10)
i = i + 1
End If
Next n
'druck der Leisten
If holzList.Range("B1") = "" Then
Else
holzList.Activate
Range(Cells(1, 1), Cells(n + 1, 11)).Select
Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Key2:=Range("C1") _
, Order2:=xlDescending, Key3:=Range("D1"), Order3:=xlDescending _
, Header:=xlNo, OrderCustom:=1 _
, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.SelectedSheets.PrintOut
End If
'sichern
aktWkb.Activate
'sichern einer Kopie auf dem Sever und anschl. csv Erstellung
ActiveWorkbook.Save
ActiveWorkbook.SaveCopyAs "z:\dekore\stkListSich\" & (spName)
ActiveWorkbook.SaveAs Filename:="C:\optstkl\" & spName, FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
'uebersicht aktualisieren
wkCSV.Activate
check
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
Sub mkStat()
Dim stkList, wkStat, wkUeber As Worksheet
Dim dekVorh As Integer
Dim m2Alt, anzZuAlt, L, M As Long
Set stkList = Workbooks("stkList").Sheets("stk")
Set wkStat = Workbooks("stkList").Sheets("stat")
Set wkUeber = Workbooks("stkList").Sheets("ueber")
dekVorh = 0: m2Alt = 0: anzZuAlt = 0
For L = 2 To wkStat.UsedRange.Rows.Count
If wkStat.Cells(L, 1).Value = dek Then
m2Alt = wkStat.Cells(L, 5).Value: anzZuAlt = wkStat.Cells(L, 4).Value
wkStat.Cells(L, 1).Value = dek: wkStat.Cells(L, 5).Value = m2 * 1.1 + m2Alt: wkStat.Cells(L, 4). _
Value = anzZu + anzZuAlt
wkStat.Cells(L, 2).Value = Left(dek, 3): wkStat.Cells(L, 3).Value = Mid(dek, 5, 2): wkStat. _
Cells(L, 6).Value = (m2 * 1.1 + m2Alt) / 5.8
dekVorh = 1
End If
Next L
If dekVorh = 1 Then GoTo Sort
wkStat.Cells(L + 1, 1).Value = dek: wkStat.Cells(L + 1, 5).Value = m2 * 1.1: wkStat.Cells(L + 1, _
4).Value = anzZu
wkStat.Cells(L + 1, 2).Value = Left(dek, 3): wkStat.Cells(L + 1, 3).Value = Mid(dek, 5, 2): _
wkStat.Cells(L + 1, 6).Value = m2 * 1.1 / 5.8
Sort:
wkStat.Activate
Columns("A:H").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False _
, Orientation:=xlTopToBottom
Range("A2").Select
'eintrag in uebersicht
M = wkUeber.UsedRange.Rows.Count
wkUeber.Cells(M + 1, 1).Value = dek: wkUeber.Cells(M + 1, 5).Value = m2 * 1.1: wkUeber.Cells(M + _
1, 4).Value = anzZu
wkUeber.Cells(M + 1, 2).Value = Left(dek, 3): wkUeber.Cells(M + 1, 3).Value = Mid(dek, 5, 2): _
wkUeber.Cells(M + 1, 6).Value = m2 * 1.1 / 5.8
wkUeber.Cells(M + 1, 7).Value = Date
End Sub