von einem Kollegen von Euch habe ich folgenden Code erhalten bezüglich Datum:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row >= 4 And Target.Row Application.RoundUp(Month( _
_
Target) / 3, 0) Then
Application.EnableEvents = False
Target.Offset(3, 0) = Target 'Datum wird 3 Zeilen unter Übertrag eingefügt
' ActiveCell.Offset(3, 1).Select
ActiveCell.Offset(2, 1).Select
ActiveCell = "Ablesedatum"
Call CommandButtonDrucken_Click1
Target = "Übertrag - Summe"
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(-4, 1).Select
ActiveCell = "Ablesedatum:"
ActiveCell.Offset(0, 1).Select
ActiveCell = Date
Selection.NumberFormat = "dd/mm/yyyy"
ActiveCell.Offset(-1, 4).Select
ActiveCell.Copy
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1:G1").Copy
ActiveCell.Offset(1, -6).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ActiveCell.Offset(1, 0).Select
ActiveCell = "Übertrag"
ActiveCell.Offset(-2, 6).Select
Selection.Copy
ActiveCell.Offset(2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(1, -5).Select
Application.EnableEvents = True
End If
End If
End Sub
Jetzt möchte ich das gleiche Ausführen jedoch nicht bei Änderung in der Tabelle, sondern, wenn das Datum innerhalb des Quartals grösser ist als das aktuelle Datum (Date).
Leider sind viele Versuche fehlgeschlagen. Daher die Bitte um Eure Hilfe.
Besten Dank
Gruss
Peter