Public
Sub
aaa()
Dim
boVollständig
As
Boolean
Application.ScreenUpdating =
False
With
Worksheets(
"Aufgaben"
)
If
MsgBox(
"Willst du die Daten wirklich ins Archiv verschieben?"
, vbYesNo,
"Tages-Sonderaufgaben"
) = vbYes
Then
If
WorksheetFunction.CountBlank(.Cells(ActiveCell.Row, 2).Resize(, 4)) = 0
Then
If
WorksheetFunction.CountBlank(.Cells(ActiveCell.Row, 8).Resize(, 2)) = 0
Then
boVollständig =
True
.Rows(ActiveCell.Row).Copy
Worksheets(
"erledigte Aufgaben"
).Rows(6).Insert Shift:=xlShiftUp
.Rows(ActiveCell.Row).Delete Shift:=xlShiftUp
.Rows(39).Copy
.Rows(40).Insert
End
If
End
If
End
If
End
With
If
Not
boVollständig
Then
MsgBox
"Es sind nicht alle Pflichtfelder ausgefüllt."
End
If
Application.CutCopyMode =
False
End
Sub