Einen Monat vor & unter Monat Speichern
23.03.2006 08:33:08
Heinz
Untere Code besagt,ein neues Monat erstellen von Montag bis Freitag,dann Zelle einfügen.
Nun möchte ich wenn ich ein neues Monat erstelle,Datum steht in G1 das mir das Tab.Blatt als " Lohnstundenerfassung & Name steht in C3 & Monat steht in G1"
Zb. "Lohnstundenerfassung Heinz April 06"
Weiters sollte das Datum von G1 automatisch um einen Monat hochgezählt werden.
Habe auch zum besseren Verständnis die Datei mal hochgeladen.
Sub WochenendeWeg()
If MsgBox("Wollen Sie ein neues Monat erstellen ?", vbQuestion + vbYesNo, _
" Nachfrage Neues Monat erstellen !") = vbNo Then Exit Sub
Dim datStart As Date, datEnd As Date
Dim lDay As Long
Dim iRow As Integer
datStart = Range("G1").Value ' in der Zelle M3 befindet sich das Anfangsdatum
datEnd = Range("H1").Value ' in der Zelle H1 befindet sich das Enddatum
iRow = 6 ' Hiermit wird gesagt, dass in Zeile 6 angefangen werden soll
For lDay = datStart To datEnd
Select Case WeekDay(lDay, 2)
Case Is < 6
Cells(iRow, 1) = lDay
Cells(iRow, 2) = lDay
iRow = iRow + 1
Case Is = 6
End Select
Next
Dim SP#, Such$, LR%, TB1, I#, M%, Z1%
'anpassen ******
Set TB1 = Sheets("Test")
SP = 2 'Spalte mit den Wochentagen
Such = "Fr"
Z1 = 6 'erste Zeile mit Daten
LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For I = LR To Z1 Step -1
If Cells(I, SP).Text = Such Then
Rows(I + 1).Insert
If I < 5 + Z1 Then
M = I - Z1 + 1
Else
M = 5
End If
Cells(I + 1, SP + 1).FormulaR1C1 = "=Sum(R[-" & M & "]C:R[-1]C)"
Range(Cells(I + 1, 1), Cells(I + 1, 15)).Interior.ColorIndex = 34
End If
Next
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub
https://www.herber.de/bbs/user/32164.xls
Anzeige