AW: Makro zum einfügen von Seiten und löschen
19.04.2016 11:19:22
Seiten
Hi Jo
Den Seitenumbruch überlasse ich anderen, aber sonst habe ich es jetzt so umgesetzt wie von dir geschrieben (ob so gewollt ist eine andere Frage).
' Bereich A95-I105
Set rngDelete1 = .Range(.Cells(Zeile_L + AnzZeilen - 10, 1), .Cells(Zeile_L + AnzZeilen, 9))
' Bereich J96-L98
Set rngDelete2 = .Range(.Cells(Zeile_L + AnzZeilen - 9, 10), .Cells(Zeile_L + AnzZeilen - 7, 12))
' löscht alles ausser Formeln (für verbundene Zellen funktioniert es leider nicht, aber vermutlich auch nicht gewollt
Sub LoeschenOhneFormeln(rng As Range)
Dim c As Range
On Error Resume Next
For Each c In rng
If Not c.HasFormula Then c.ClearContents
Next c
End Sub
Sub Copy_neue_Woche()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim wks As Worksheet
Dim Zeile_L As Long, Zeile1 As Long, Zeile2 As Long
Dim AnzZeilen As Long
Dim rngCopy As Range, rngDelete1 As Range, rngDelete2 As Range
Set wks = ActiveWorkbook.Sheets("Wochenverkauf")
AnzZeilen = 35 'Zeilen pro Seite
With wks
'letzte Zeile in Spalte A - Zeile mit Formeln z.B =WENN(B70="";"";"./.")"
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
'zu kopierender Bereich der letzten Woche
Set rngCopy = .Range(.Rows(Zeile_L - AnzZeilen + 1), .Rows(Zeile_L))
Set rngDelete1 = .Range(.Cells(Zeile_L + AnzZeilen - 10, 1), .Cells(Zeile_L + AnzZeilen, _
9))
Set rngDelete2 = .Range(.Cells(Zeile_L + AnzZeilen - 9, 10), .Cells(Zeile_L + AnzZeilen _
- 7, 12))
.Unprotect
rngCopy.Copy .Rows(Zeile_L + 1)
'Seitenwechsel oberhalb neuer Seite einfügen
.HPageBreaks.Add Before:=.Cells(Zeile_L + 1, 1)
'Zeilenbereich mit den Eingabewerten zu Verkauf / Wochenbstand / Arbeitsdienst
Zeile1 = Zeile_L + 6 'Zeile 1. Artikel
Zeile2 = Zeile_L + AnzZeilen - 11 'Zeile mit letztem Artikel
'Inhalte in Eingabezellen zu den Artikeln in Spalte D (Einkauf in Flaschen) löschen
' .Range(.Cells(Zeile1, 4), .Cells(Zeile2, 4)).ClearContents
'Inhalte in Eingabezellen zu den Artikeln in Spalte F bis G (Wochenbestand/ _
Arbeitsdienst)löschen
.Range(.Cells(Zeile1, 6), .Cells(Zeile2, 7)).ClearContents
'Zeilenbereich mit den Eingabewerten für zusätzliche Ausgaben/Einnahmen
Zeile1 = Zeile_L + AnzZeilen - 10 'Zeile mit Getränkeeinkauf / Bargeld Kasse
Zeile2 = Zeile_L + AnzZeilen 'letzte Zeile
'In Spalte B die Eingaben für zusätzliche Ausgaben unterhalb "Geträngeeinkauf" löschen
.Range(.Cells(Zeile1 + 1, 2), _
.Cells(Zeile2, 2)).ClearContents 'Spalte B
'In Spalten C die Eingaben der Beträge für zusätzliche Ausgaben löschen
.Range(.Cells(Zeile1 + 1, 3), _
.Cells(Zeile2, 3)).ClearContents 'Spalte C
'In Spalte F:G die Eingaben für zusätzliche Einnahmen löschen - 5 Zeilen unterhalb " _
Bargeld Kasse"
.Range(.Cells(Zeile1 + 1, 6), _
.Cells(Zeile1 + 5, 7)).ClearContents 'Spalte E:F - nicht verbundene Zellen
'In Spalte F:G die Eingaben für zusätzliche Einnahmen löschen - restliche Zeilen _
unterhalb "Bargeld Kasse"
.Range(.Cells(Zeile1 + 6, 6), _
.Cells(Zeile2, 7)).ClearContents 'Spalte E:F - verbundene Zellen
'In Spalte I die Eingaben der Beträge für zusätzliche Einnahmen löschen
.Range(.Cells(Zeile1, 9), _
.Cells(Zeile2, 9)).ClearContents 'Spalte I
Call LoeschenOhneFormeln(rngDelete1)
Call LoeschenOhneFormeln(rngDelete2)
.Protect
Cells(Zeile_L + 6, 4).Select
Call CopyWocheFlaschenauswertung(Zeile_1WA:=Zeile_L + 6, Zeile_LWA:=Zeile_L + AnzZeilen _
- 10)
.Activate
End With
Application.Calculation = xlCalculationAutomatic
End Sub
Betr. Datumsproblem, in folgender Zeile "+7" ergänzen:
.Cells(Zeile_LFA + 2, 1).FormulaR1C1 = "=R[-" & AnzZeilen_FA & "]C+7"
cu
Chris