Codezeile richtig einsetzen
15.11.2007 02:52:00
Heinz
Der untere Code besagt nach Sonntag soll eine Zeile eingefügt werden,mit einer Formel.
Das funkt.auch ( DANKE an Tino )
Nun sollte die Codzeile
"Cells(i + 1, sp + 4).FormulaR1C1 = "=IF(RC[3]=""Feiertag"","""",IF(WEEKDAY(RC[-5],2)=1,R50C7,IF(WEEKDAY(RC[-5],2)=2,R51C7,IF(WEEKDAY(RC[-5],2)=3,R52C7,IF(WEEKDAY(RC[-5],2)=4,R53C7,IF(WEEKDAY(RC[-5],2)=5,R54C7,""""))))))"
in die Zeile eingefügt werden wo in B6:B42 Montag bis Freitag steht.
Könnte mir bitte jemand weiterhelfen.
Danke Heinz
Option Explicit
Sub cp_wbk()
Dim wbk_neu As Workbook
Dim wbk_alt As Workbook
Dim MyFileName As String
Dim MyPfad As String
Dim MyShape As Shape
Set wbk_alt = ActiveWorkbook
Set wbk_neu = Workbooks.Add
wbk_alt.Activate
MyPfad = ThisWorkbook.Path & "\" 'anpassen
MyFileName = Range("B3") & " " & Format([A6], "mmmm YYYY")
wbk_alt.Sheets(1).Copy before:=wbk_neu.Sheets(1)
For Each MyShape In wbk_neu.Sheets(1).Shapes
If MyShape.AlternativeText "Neues Monat anlegen" Then MyShape.Delete
Next
wbk_neu.SaveAs MyPfad & MyFileName
wbk_neu.Close
'MsgBox "Sicherung siehe: " & MyPfad & MyFileName
End Sub
Sub WochenendeWeg()
If MsgBox("Wollen Sie ein neues Monat erstellen ?", vbQuestion + vbYesNo, _
" Nachfrage Neues Monat erstellen !") = vbNo Then Exit Sub
Call cp_wbk
'-------Monat um 1 Hochzählen----------
'In G1 steht jetzt eine Formel, die nicht mehr geändert werden muss,
'daher wird nur noch F1 geändert.
Range("F1") = DateAdd("m", 1, Range("F1"))
'Blattname neu bestimmen
ActiveSheet.Name = Range("G1")
Dim datStart As Date, datEnd As Date
Dim lDay As Long
Dim iRow As Integer
datStart = Range("F1").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
'Bevor die Daten des neuen Monats eingetragen werden, alte Daten löschen.
'Anschließend Zahlenformate in den Spalten A und B wiederherstellen
'Range("A" & iRow & ":A100").EntireRow.Delete
Range("A6:A42").EntireRow.ClearContents ' Franz Zeile geändert. Statt löschen der Zeilen _
werden nur Inhalte gelöscht
Range("A6:A42").EntireRow.Interior.ColorIndex = xlColorIndexNone 'Franz entfernt Farbe aus _
Zellbereich
Range("A6:A42").NumberFormatLocal = "TT.MM.JJJJ"
Range("B6:B42").NumberFormatLocal = "TTT"
For lDay = datStart To datEnd
Cells(iRow, 1) = lDay
Cells(iRow, 2) = lDay
iRow = iRow + 1
iRow = iRow - (Weekday(lDay, 2) = 7)
Next
Dim sp#, Such$, LR%, TB1, i#, m%, Z1%
'anpassen ******
Set TB1 = Sheets(ActiveSheet.Name)
sp = 2 'Spalte mit den Wochentagen
Such = "So"
Z1 = 6 'erste Zeile mit Daten
Dim M1%
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 'Zeile zu Kommentar gemacht, da Leerzeile zwischen Wochen _
schon vorhanden
If i 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub