Problem bei Worksheet_change
09.05.2016 08:48:41
Peter
benötige wieder einmal eure Hilfe.
Ihr habt mir bereits bei Worksheet_Change geholfen. Ich habe jedoch noch ein Problem.
Wenn die Tabelle leer ist bzw. in A2 "Anfangsbestand" steht, dann kann beim Eintrag
eines Datums ein Worksheet_Change nicht stattfinden. Hier habe ich einen Abbruch.
Wie kann ich den Code umschreiben, damit beim ersten Eintrag dieses Worksheet_Change
nicht ausgeführt wird dann aber immer?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row >= 2 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
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 = "m/d/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
Danke für eure Hilfe.
Gruss Peter