AW: Artikel in nächste freie Zeile der Bestellung
08.04.2014 16:52:40
UweD
Hallo nochmal
- Das alte makro löschen
- Rechtsclick auf den Tabellenblattreiter "Artikelliste"
- Code anzeigen
- das folgende Makro einfügen
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
If Not Intersect(Range("L11:L82"), Target) Is Nothing Then
If Target.Count 1 Then
MsgBox "Nur eine Zelle ändern"
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Exit Sub
End If
If Target.Value "" Then
Dim TB1, TB2
Dim SP%, ZE&, LR1&, LR2&
Dim Lief$
Application.ScreenUpdating = False
Set TB1 = Sheets("Artikelliste")
SP = 2 'Spalte B
ZE = 15 'früheste Einfügezeile
Lief = Me.Cells(Target.Row, 11) 'Lieferant
'prüfen auf Bestellformular
On Error Resume Next
Set TB2 = Sheets("Bestellformular " & Lief)
If Err.Number 0 Then
MsgBox "Bestellung für Lieferant" & vbLf & vbLf & " " & Lief & vbLf & vbLf _
& "nicht vorhanden"
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
Err.Clear
Exit Sub
End If
On Error GoTo Fehler
LR2 = WorksheetFunction.Max(TB2.Cells(Rows.Count, SP).End(xlUp).Row + 1, ZE)
TB2.Cells(LR2, 2) = Me.Cells(Target.Row, 2) 'Artikel
TB2.Cells(LR2, 4) = TB1.Cells(Target.Row, 3) 'Bez
TB2.Cells(LR2, 9) = TB1.Cells(Target.Row, 8) 'Einheit
TB2.Cells(LR2, 10) = TB1.Cells(Target.Row, 12) 'Menge
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
Application.EnableEvents = True
End Sub
zusätzlich in eine normales Modul folgendes Makro
Sub Resetten()
On Error GoTo Fehler
Dim WB, SH
Set WB = ActiveWorkbook
For Each SH In WB.Sheets
If InStr(SH.Name, "Bestellformular") > 0 Then
Application.EnableEvents = False
SH.Range("B15:J35").ClearContents
Application.EnableEvents = True
End If
Next
Application.EnableEvents = False
Sheets("Artikelliste").Range("L11:L82").ClearContents
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.EnableEvents = True
End Sub
Dieses Makro auf einen Button im Blatt Artikelliste legen.
Gruß UweD