Makro nach Jahreswechsel anpassen

Sub AuswertungTage() 'mit direkter Übertragung der Zellwerte
Dim strFormula As String, strFile As String, strPath As String, lngKW As Long
Dim vVorgabe, Zeile As Long, Spalte As Long, Tag As Long, Zeile1 As Long, Maschine
Dim wbKW As Workbook, wksKW As Worksheet, wksKW2 As Worksheet
Dim wksTagesdaten As Worksheet, wksWochendaten As Worksheet
On Error GoTo ErrExit
Set wksTagesdaten = ActiveWorkbook.Worksheets("Tagesdaten_2016")
Set wksWochendaten = ActiveWorkbook.Worksheets("Auswertung über Wochen")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
strPath = IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\")
With wksTagesdaten
'nächste leere Zeile in Liste in Spalte "KW"
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
If Zeile = 2 Then ' noch keine Daten in Tabelle
lngKW = 1
Else
lngKW = .Cells(Zeile - 1, 2).Value + 1 'nächste KW
vVorgabe = Application.InputBox(Prompt:="Ab welcher KW sollen Daten eingelesen werden?" _
& vbLf & "Bei Eingabe 1 werden alle Daten neu eingelesen" _
& vbLf & "Letzte eingelesene KW: " & lngKW - 1, _
Title:="Tagesdaten der KW einlesen", Default:=lngKW, Type:=1)
If vVorgabe = False Then GoTo Beenden
If vVorgabe  "" Then
'KW-Datei öffnen
Set wbKW = Workbooks.Open(Filename:=strPath & strFile, ReadOnly:=True)
Set wksKW = wbKW.Worksheets(cstrSheet)
Set wksKW2 = wbKW.Worksheets(cstrSheet2)
'Daten der Tage der KW einlesen
With wksTagesdaten
Zeile1 = Zeile
For Tag = 1 To 6
Spalte = 8 + (Tag - 1) * 6 '1. Spalte des Tages (Anzahl Schichten)
'Werte für Jahr-KW-Datum für alle Maschinen
.Range(.Cells(Zeile, 1), .Cells(Zeile + AnzMaschinen - 1, 1)).Value = _
wksKW.Cells(1, 1)       'Jahr aus Zelle A1 (A2 ?) einlesen
.Range(.Cells(Zeile, 2), .Cells(Zeile + AnzMaschinen - 1, 2)).Value = _
wksKW.Cells(1, 2)       'KW aus Zelle B1 (C1 ?) einlesen
.Range(.Cells(Zeile, 3), .Cells(Zeile + AnzMaschinen - 1, 3)).Value = _
wksKW.Cells(5, Spalte)  'Tages-Datum aus Zeile 5
'Werte für Daten zu den einzelnen Maschinen eintragen
For Maschine = 1 To AnzMaschinen
Spalte = 8 + (Tag - 1) * 6 '1. Spalte des Tages (Anzahl Schichten)
.Cells(Zeile, 4).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, 1)  'Maschinen-Nr.
.Cells(Zeile, 5).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, 2) 'Maschine-Produkt
.Cells(Zeile, 6).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte)   ' Stück Frühschicht
.Cells(Zeile, 7).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte + 1)  'Stück Spätschicht
.Cells(Zeile, 8).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte + 2)  'Stück Nachtschicht
.Cells(Zeile, 11).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte + 3)  'AnzRüst
.Cells(Zeile, 12).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte + 4)  'Rüstz
.Cells(Zeile, 9).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte + 5) 'Ist Stückzahl
'.Cells(Zeile, 10).Offset(Maschine - 1, 0).Value = _
wksKW.Cells(Maschine + 6, Spalte) 'Anzahl Schichten
'Anzahl Schichten einlesen
Spalte = 8 + (Tag - 1) * 4 '1. Spalte des Tages (Anzahl Schichten)
'Werte für Daten zu den einzelnen Maschinen eintragen
.Cells(Zeile, 10).Offset(Maschine - 1, 0).Value = _
wksKW2.Cells(Maschine + 6, Spalte) 'Anzahl Schichten
Next
'1. Zeile für nächsten Tag
Zeile = Zeile + AnzMaschinen
Next
End With
'Formeln/Werte in Wochenauswertung aktualisieren
With wksWochendaten
strFormula = "'[" & strFile & "]" & cstrSheet2 & "'!"
With .Range(.Cells(10, lngKW + 1), .Cells(32, lngKW + 1))
.Formula = "=SUMPRODUCT((" & strFormula _
& "$A$7:$A$29=$A10)*(MOD(COLUMN($H:$AE)-7,4)=0)*" & strFormula & "$H$7:$AE$29)"
.Calculate
'.Value = .Value
End With
End With
'Datei mit KW_Daten wieder schliessen
wbKW.Close savechanges:=False
Set wbKW = Nothing
Set wksKW = Nothing
Set wksKW2 = Nothing
End If
Next lngKW
With wksTagesdaten
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten
End With
'Formeln/Werte in Monatsauswertung aktualisieren
With Worksheets("Auswertung über Monate")
With .Range("E2:P23")
.FormulaR1C1 = _
"=SUMPRODUCT((RC1=Tagesdaten_2016!R2C4:R" & Zeile & "C4)*(MONTH(R1C)=MONTH( _
Tagesdaten_2016!R2C3:R" _
& Zeile & "C3))*Tagesdaten_2016!R2C9:R" & Zeile & "C9)"
.Calculate
'.Value = .Value 'Zeile aktivieren, wenn im Zellbereich keine Formeln stehen sollen
End With
'Formeln/Werte in Monatsauswertung Schichten aktualisieren
With .Range("E30:P51")
.FormulaR1C1 = _
"=SUMPRODUCT((RC1=Tagesdaten_2016!R2C4:R" & Zeile & "C4)*(MONTH(R1C)=MONTH( _
Tagesdaten_2016!R2C3:R" _
& Zeile & "C3))*Tagesdaten_2016!R2C9:R" & Zeile & "C9)/SUMPRODUCT((RC1=Tagesdaten_2016!  _
_
R2C4:R" & Zeile & "C4)*(MONTH(R1C)=MONTH(Tagesdaten_2016!R2C3:R" _
& Zeile & "C3))*Tagesdaten_2016!R2C10:R" & Zeile & "C10)"
.Calculate
'.Value = .Value 'Zeile aktivieren, wenn im Zellbereich keine Formeln stehen sollen
End With
End With
With wksTagesdaten
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten
End With
'Formeln/Werte in Wochenauswertung Schichten aktualisieren
With wksWochendaten  'Worksheets("Auswertung über Wochen_2012")
With .Range("B41:BA63")
.FormulaR1C1 = _
"=SUMPRODUCT((RC1=Tagesdaten_2016!R2C4:R" & Zeile & "C4)*(R40C=Tagesdaten_2016!R2C2:R" &   _
_
Zeile & "C2)*(Tagesdaten_2016!R2C15:R" _
& Zeile & "C9))/SUMPRODUCT((RC1=Tagesdaten_2016!R2C4:R" & Zeile & "C4)*(R40C= _
Tagesdaten_2016!R2C2:R" & Zeile & "C2)*(Tagesdaten_2016!R2C16:R" & Zeile & "C10))"
.Calculate
'.Value = .Value 'Zeile aktivieren, wenn im Zellbereich keine Formeln stehen sollen
End With
End With
ErrExit:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
If Not wbKW Is Nothing Then wbKW.Close savechanges:=False
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub