Code beenden wenn Makro ausgeführt wird
12.09.2006 13:05:55
Sven
Wenn ich auf einen Button klicke, dann soll dieser Code umgangen werden
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Bestellnummer, c As Range, lz As Long
On Error GoTo ende
If Cells(Target.Row, 9) <= Cells(Target.Row, 10) Then
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c(1, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'wenn Bestellnummer bereits vorhanden, dann Wert überschreiben
Else
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Reihen jeweils um 1 erweitern
.Cells(lz, 1) = Cells(Target.Row, 7) 'kopiert Artikelnummer nach Bestellung in Spalte 1
.Cells(lz, 2) = Cells(Target.Row, 3) 'kopiert Warengruppe nach Bestellung in Spalte 2
.Cells(lz, 3) = Cells(Target.Row, 4) 'kopiert Artikelname nach Bestellung in Spalte 3
.Cells(lz, 4) = Cells(Target.Row, 5) 'kopiert Inhalt nach Bestellung in Spalte 4
.Cells(lz, 5) = Cells(Target.Row, 8) - Cells(Target.Row, 9) 'Differenz aus Soll-Ist in Spalte 5
End If
End With
Else
---------------dieser Bereich soll dann unterbrochen werden --------------
With Sheets("Bestellung")
Bestellnummer = Cells(Target.Row, 7)
Set c = .Columns(1).Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
.Rows(c.Row).Delete shift:=xlUp
End If
End With
End If
If Cells(Target.Row, 11) <> "" Then Cells(Target.Row, 11) = "" 'nach Zugang Zelle leeren
If Cells(Target.Row, 12) <> "" Then Cells(Target.Row, 12) = "" 'nach Abagng Zelle leeren
ende:
End Sub
und zwar bei diesem KLick
'bestellung auslösen
Sub Schaltfläche1_BeiKlick()
With Sheets("Bestand")
For z = 13 To Cells(Rows.Count, 1).End(xlUp).Row
Bestellnummer = Cells(z, 1)
Set c = .Cells.Find(What:=Bestellnummer, LookIn:=xlValues, LookAt:=xlWhole)
Sheets("Bestand").Unprotect Password:="Sommer12"
If Not c Is Nothing Then c(1, 3) = c(1, 2): c(1, 7) = "aktiv"
Next z
Sheets("Bestellung").Unprotect Password:="Sommer12"
Range("a13:e130").Select
Selection.Sort Key1:=Range("c13"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a13").Select
Sheets("Bestellung").PrintOut Copies:=1, Collate:=True
Sheets("Bestellung").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End With
Sheets("Bestand").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Sommer12"
End Sub
Danke und Gruß
Sven