26.08.2019, 14:23
Hallo,
da fehlte auch noch das Workbook
da fehlte auch noch das Workbook
Code:
Sub MachMirEinenMonat()
Dim wksQuelle As Worksheet
Dim vntDatum As Variant
Dim lngMonat As Long
Dim lngJahr As Long
Dim wbkNeu As Workbook
Dim lngTageImMonat As Long
Dim lngTag As Long
Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")
vntDatum = InputBox("Gib ein beliebiges Datum des gew?nschten Monats ein!" & vbCr & "Beispiel: 13.2.2012")
If Not IsDate(vntDatum) Then
MsgBox "Kein Datum!", , vntDatum
Exit Sub
End If
lngMonat = Month(vntDatum)
lngJahr = Year(vntDatum)
lngTageImMonat = Day(DateSerial(lngJahr, lngMonat + 1, 0))
wksQuelle.Copy
Set wbkNeu = ActiveWorkbook
For lngTag = 2 To lngTageImMonat
wbkNeu.Worksheets(1).Copy After:=wbkNeu.Worksheets(wbkNeu.Worksheets.Count)
Next
For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
If lngTag > 1 Then wbkNeu.Worksheets(lngTag).Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then wbkNeu.Worksheets(lngTag).Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"
Next
End Sub
Gruß Stefan
Win 10 / Office 2016
Win 10 / Office 2016