Ich habe eine Tabelle mit Namen "Vorlage" diese öffne ich am 1. eines Monats darauf hin wird mir mit diesem Code:
Option Explicit
Sub WochenAnlegen()
Dim datStart As Date, datEnd As Date, lKW As Long
Dim strName As String
On Error Resume Next
Application.ScreenUpdating = False
datStart = DateSerial(Year(Date), Month(Date), 1)
If Month(Date) = 12 Then
datEnd = DateSerial(Year(Date), Month(Date), 31)
Else
datEnd = DateSerial(Year(Date), Month(Date) + 1, 1) - 1
End If
datStart = datStart - Weekday(datStart, 2) + 1 ' geht auf den Montag <= datstart
For lKW = datStart + 7 To datEnd Step 7
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(ISOWeek(CDate(lKW)), "00") & ".-Woche"
Sheets("Vorlage").Cells.Copy ActiveSheet.Cells(1, 1)
Range("AK1").Value = CDate(lKW)
Next lKW
With Worksheets(1)
.Name = Format(ISOWeek(CDate(datStart)), "00") & ".-Woche"
strName = Left(.Name, 3)
.Select
End With
If Year(datStart) <> Year(Date) Or Month(datStart) <> Month(Date) Then
Range("AK1").Value = DateSerial(Year(Date), Month(Date), 1)
Else
Range("AK1").Value = CDate(datStart)
End If
strName = JahrOrdnerAnlegen(datEnd) & strName _
& "-" & Format(ISOWeek(CDate(lKW - 7)), "00") & ".Woche.xls"
ActiveWorkbook.SaveAs strName
Application.ScreenUpdating = True
Columns("AL:AL").Select
Selection.Font.ColorIndex = 3
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Selection.NumberFormat = "0.0"
Range("P13").Select
Hier komme ich nicht weiter!!!!!!!!!!!!!!
'Sheets(2).Range("AL13").FormulaLocal = "AK13" + Sheets(1).Range("AK13")
End Sub
Function ISOWeek(dat As Date) As Integer
Dim dbl As Double
dbl = DateSerial(Year(dat + (8 - _
Weekday(dat)) Mod 7 - 3), 1, 1)
ISOWeek = (dat - dbl - 3 + _
(Weekday(dbl) + 1) Mod 7) \ 7 + 1
End Function
Function JahrOrdnerAnlegen(datBis As Date) As String
Dim sPath As String, dat As Date
dat = Range("AK1").Value
sPath = "C:\Temp\Stunden\"
On Error Resume Next
MkDir sPath & Year(dat)
sPath = sPath & Year(dat) & "\"
MkDir sPath & Format(dat, "mmmm")
sPath = sPath & Format(dat, "mmmm") & "\"
On Error GoTo 0
JahrOrdnerAnlegen = sPath
End Function
die Wochen für den jeweiligen Monat angelegt.In Zelle AK13 werden die GesamtWochen Stunden der jeweiligen Woche errechnet. Wie erreicht man nun das in Zelle AL 13 die Stunden der 1.Woche dazugrechnet werden.
Falls es nicht richtig verständlich ist könnte ich nur ein gekürzte Fassung mal hochschieben.
Hoffe das jemand eine Idee hat.
Gruß René