Einen Monat vor & unter Monat Speichern

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