Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Const
c_lngSpNrAuftrAbgeschl
As
Long
= 41
Const
c_strArchiv
As
String
=
"Archiv"
Const
c_lngZeileMaxArchiv
As
Long
= 65536
Dim
lngZeileArchiv
As
Long
Dim
wksArchiv
As
Excel.Worksheet
With
Target.Cells
If
.Column = 6
Then
If
ActiveCell.Value =
"Ja"
Then
Call
Kundenauftrag
End
If
End
If
If
.Column = 7
Then
If
ActiveCell.Value =
"Ja"
Then
Call
Auftragsdaten
End
If
End
If
If
Len(.Address) = 4
Then
If
.Column = c_lngSpNrAuftrAbgeschl
And
.Value =
"ü"
Then
Set
wksArchiv = ThisWorkbook.Sheets(c_strArchiv)
lngZeileArchiv = wksArchiv.Cells(wksArchiv.Rows.Count, 1).
End
(xlUp).Row + 1
If
lngZeileArchiv = c_lngZeileMaxArchiv
Then
MsgBox
"Das Archiv ist voll!"
, vbCritical,
"F E H L E R !"
Else
.EntireRow.Copy Destination:=wksArchiv.Rows(lngZeileArchiv)
.EntireRow.Delete xlShiftUp
End
If
Set
wksArchiv =
Nothing
End
If
End
If
End
With
End
Sub