Wert aus Vortag übernehmen

[Coprat]

Hallo,

ich benutze folgenden Code um mir einen Monat zu generieren

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("MeinBeispiel")

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")
Next

'lösche alle Sonntage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 1 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

'lösche alle Samstage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 7 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

End Sub

Kann man diesen Code erweitern, so dass in den den Zellen B53:O53 und B62:P62 die Werte aus dem Vortag aus B57:O57 und B66:P66 übernommen werden. Also als Formel z.B.

Code:

='03.09'!B57

diese Formel würde auf Tabellenblatt 04.09 in Zelle B53 stehen.

Am ersten Tag des Monats würde der Wert händich eingetragen werden.


Vielen Dank für eure Gedanken

[schauan]

Hallöchen,

das Einfügen der Formel könnte z.B. in diesen Bereich:

For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
if lngTag > 1 then Rang("B53:O53").Formule = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag-1), "dd.mm") & "'!B57"
Next

(ungetestet)

[Coprat]

Hallöchen,

das Einfügen der Formel könnte z.B. in diesen Bereich:

For lngTag = 1 To lngTageImMonat
wbkNeu.Worksheets(lngTag).Name = Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")
'hier formel einfuegen
if lngTag > 1 then Range("B53:O53").Formule = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag-1), "dd.mm") & "'!B57"
Next

(ungetestet)

Danke erst mal das mit Range habe ich noch selber rausgefunden aber nach dem umbennen der ersten beiden Tabellenblätter sagt er Objekt unterstützt Eigenschaft oder Methode nicht

Ne Idee?

[snb]

Zum erstellen der Arbeisblätter reicht schon aus:

Code:

Sub M_snb()
   y = CLng(InputBox("Monatsnummer 1-12", "snb", 1))
   
   For j = 1 To 31
     x = DateSerial(Year(Date), y, j)
     If Weekday(x, 2) < 6 And Month(x) = y Then
        Sheets(1).Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Format(x, "dd.mm")
     End If
   Next
End Sub

[schauan]

Hallöchen,

meine Tastatur und ich gehen heute wohl getrennte Wege Formule sollte auch Formula sein

[Coprat]

Hallo Schauaun,

der Code sieht jetzt folgendermaßen aus

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 Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
Next

'lösche alle Sonntage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 1 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

'lösche alle Samstage
For lngTag = 1 To lngTageImMonat
If Weekday(DateSerial(lngJahr, lngMonat, lngTag)) = 7 Then
 Application.DisplayAlerts = False
 wbkNeu.Worksheets(Format(DateSerial(lngJahr, lngMonat, lngTag), "dd.mm")).Delete
 Application.DisplayAlerts = True
End If
Next

End Sub

Leider stehen trotzdem keine Formeln drin. Die Tag werden erstellt wie vorher nur die Formeln sind nicht in den Zellen und der Ertste Tag wird nicht mehr erstellt.

Hast du eine Idee?

[snb]

Code:

Sub M_snb()
   y = CLng(InputBox("Monatsnummer 1-12", "snb", 1))
   
   For j = 1 To 31
     x = DateSerial(Year(Date), y, j)
     If Weekday(x, 2) < 6 And Month(x) = y Then
        Sheets(1).Copy , Sheets(Sheets.Count)
        with Sheets(Sheets.Count)
           .Name = Format(x, "dd.mm")
           .cells.replace("*!"),.name & "!",2
        end with
     End If
   Next
End Sub

[Coprat]

Hallo SNB,

auch hier das Problem, dass der erste Tag nicht angelegt wird und die Formeln nicht eingetragen wird. Wo steht denn in welche Zellen die Formel eingetragen wird?


LG Sven
Mit dem ersten Tag nicht angelgt könnt Ihr vergessen ist ja klar wenn der ewrste Tag nen Samstag bzw Sonntag ist Liegt es dann daran, dass die Formeln nicht eingegeben werden?

---

Code:

'hier formel einfuegen
If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"
Next

So habe ich das jetzt angepasst um meine Bereiche wo die Formeln hin sollen auch klappt

Excel macht dies aber nur auf dem letzten Tabellenblatt des Monats Warum?

[Steffl]

Hallo,

IMHO fehlt es da an einer korrekten Referenz.

Code:

If lngTag > 1 Then Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Worksheets(lngTag).Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"

[Coprat]

Index außerhalb des gültigen Bereichs




mit meiner erweiterung hat es geklappt halt nur auf dem Letzten reiter. Jetzt Sthen am letzten Tag des Monats in Zellen B53:O53 und in Zellen B62:P62 die werte von dem vorletzten Tag aus B57:O57 bzw B66:P66
Bei Schauaun war es auch nur auf der letzten Seite

---

Also nochmal der komplette Code wie ich Ihn benutze Ich habe das entfernen von Samstag und Sonntag rausgenommen, dann klappt es auf dem letzten Blatt mit dem einfügen der Formel.

wie bekomme ich es hin, dass auf allen außer dem ersten Blatt des Monats die Formel eingegeben wird?

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 Range("B53:O53").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B57"
If lngTag > 1 Then Range("B62:P62").Formula = "='" & Format(DateSerial(lngJahr, lngMonat, lngTag - 1), "dd.mm") & "'!B66"
Next

End Sub

Danke für eure Überlegungen