Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Annette,
ich habe mir die Datei jetzt nicht herunter geladen. Hatte den Code schon fertig.
Lösche das Worksheet_Change-Makro.
Folgender Code kommt in ein normales VBA-Modul.
Weise dem Button diesen Code zu. Sub EintragungenUebernehmen()
Dim varZeile As Variant
If Not IsEmpty(Range("D4")) And (Not IsEmpty(Range("E18")) Or Not IsEmpty(Range("E20"))) Then
With Worksheets("Artikel")
If .FilterMode Then .ShowAllData
varZeile = Application.Match(Range("D4").Value, .Columns(1), 0)
If Not IsError(varZeile) Then
With .Cells(varZeile, 6)
.Value = .Value - Range("E18").Value + Range("E20").Value
End With
Else
MsgBox "Die Artikelnummer " & Range("D4").Value & " wurde nicht gefunden.", vbInformation
End If
End With
Range("D4,E18,E20") = ""
Range("D4,E18,E20").Select
End If
End Sub Gruß Uwe
Registriert seit: 21.07.2016
Version(en): 2007
Hallo Annette,
noch eine Anmerkung zu Deinen Sverweisen.
Diese solltest Du wie folgt ändern (Beispiel für Artikelbezeichnung). Kannst Du so aber für alle übernehmen:
Eingabemaske | B | C | D | E | F | G | H | I | J | K | L | M | 6 | ARTIKELBEZEICHNUNG | | Formeln der Tabelle | Zelle | Formel | D6 | =WENNFEHLER(SVERWEIS($D$4;Artikel!A$1:$F$9982;2;WAHR);"") |
| Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Auf diese Art wird Dir kein NV angezeigt wenn Du keine Artikelnummer eingetragen hast.
Gruß
Ich
Registriert seit: 27.09.2016
Version(en): 2010
Guten Morgen,
habe den neuen Code eingefügt aber es klappt leider überhaupt nicht.
danke
Annette
Vielen Dank den lieben Helfern!
artcreativity
Merken
Registriert seit: 21.07.2016
Version(en): 2007
Hallo Annette,
wie hast Du das denn genau gemacht?
Gruß
Ich
Registriert seit: 27.09.2016
Version(en): 2010
habe den Sverweis geändert
danke
Annette
Vielen Dank den lieben Helfern!
artcreativity
Merken
Registriert seit: 21.07.2016
Version(en): 2007
Der Code von Uwe funktionierte bei meinem Test einwandfrei in Deiner Datei.
Da muss irgendetwas schief gegangen sein.
Registriert seit: 27.09.2016
Version(en): 2010
Entschuldigung
der Code funktioniert schon,aber da ich ja nur ein Code dem Button hinterlegen kann geht jetzt meine Archiveintragung verloren.
Wie kann ich folgende Teil noch einbauen?
Dim Loletzte As Long
Sheets("Archiv").Unprotect Password:="0000" 'Hier Dein Passwort eintragen
With Worksheets("Archiv")
Loletzte = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row + 1, 65536)
Cells(Loletzte, 4) = Sheets("Eingabemaske").Cells(20, 5) 'Abgang
Cells(Loletzte, 1) = Sheets("Eingabemaske").Cells(4, 4) 'Artikelnummer
Cells(Loletzte, 3) = Sheets("Eingabemaske").Cells(18, 5) 'Zugang
Cells(Loletzte, 2) = Sheets("Eingabemaske").Cells(6, 4) 'Bezeichnung
'Hier kannst Du die weiteren Punkte eintragen
End With
End Sub
Einfach dazwichen setzten klappt nicht richtig
danke
Annette
Vielen Dank den lieben Helfern!
artcreativity
Merken
Registriert seit: 21.07.2016
Version(en): 2007
Dein "Dim loletzte as Long" fügst Du in Uwes Code hinter "Dim VarZeile as Variant" ein.
Den Rest Deines Codes packst Du hinter das "End With".
Registriert seit: 27.09.2016
Version(en): 2010
Hallo Ochbinich
habe den Code eingefügt und geändert:
SubEintragungenUebernehmen()
Dim varZeile As Variant
Dim Loletzte As Long
If Not IsEmpty(Range("D4")) And (Not IsEmpty(Range("E18")) Or Not IsEmpty(Range("E20"))) Then
With Worksheets("Artikel")
If .FilterMode Then .ShowAllData
varZeile = Application.Match(Range("D4").Value, .Columns(1), 0)
If Not IsError(varZeile) Then
With .Cells(varZeile, 6)
.Value = .Value - Range("E18").Value + Range("E20").Value
End With
Sheets("Archiv").Unprotect Password:="0000" 'Hier Dein Passwort eintragen
With Worksheets("Archiv")
Loletzte = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row + 1, 65536)
Cells(Loletzte, 4) = Sheets("Archiv").Cells(20, 5) 'Abgang
Cells(Loletzte, 1) = Sheets("Archiv").Cells(4, 4) 'Artikelnummer
Cells(Loletzte, 3) = Sheets("Archiv").Cells(18, 5) 'Zugang
Cells(Loletzte, 2) = Sheets("Archiv").Cells(6, 4) 'Bezeichnung
'Hier kannst Du die weiteren Punkte eintragen
End With
Else
MsgBox "Die Artikelnummer " & Range("D4").Value & " wurde nicht gefunden.", vbInformation
End If
End With
Range("D4,E18,E20") = ""
Range("D4,E18,E20").Select
End If
End Sub
klappt leider nicht ganz,muss noch ein Fehler sein
danke Annette
Vielen Dank den lieben Helfern!
artcreativity
Merken
Registriert seit: 21.07.2016
Version(en): 2007
Hallo Annette,
pack das in ein Modul und entferne die entsprechenden Codes hinter den Blättern.
Sub EintragungenUebernehmen()
Dim varZeile As Variant
If Not IsEmpty(Range("D4")) And (Not IsEmpty(Range("E18")) Or Not IsEmpty(Range("E20"))) Then
With Worksheets("Artikel")
If .FilterMode Then .ShowAllData
varZeile = Application.Match(Range("D4").Value, .Columns(1), 0)
If Not IsError(varZeile) Then
With .Cells(varZeile, 6)
.Value = .Value - Range("E18").Value + Range("E20").Value
End With
Else
MsgBox "Die Artikelnummer " & Range("D4").Value & " wurde nicht gefunden.", vbInformation
End If
End With
Call kopieren
With Worksheets("Artikel")
Range("D4,E18,E20") = ""
Range("D4,E18,E20").Select
End With
End If
End Sub
Sub kopieren()
Dim Loletzte As Long
Sheets("Archiv").Unprotect Password:="0000" 'Hier Dein Passwort eintragen
With Worksheets("Archiv")
Loletzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(Loletzte, 4) = Sheets("Eingabemaske").Cells(20, 5) 'Abgang
.Cells(Loletzte, 1) = Sheets("Eingabemaske").Cells(4, 4) 'Artikelnummer
.Cells(Loletzte, 3) = Sheets("Eingabemaske").Cells(18, 5) 'Zugang
.Cells(Loletzte, 2) = Sheets("Eingabemaske").Cells(6, 4) 'Bezeichnung
'Hier kannst Du die weiteren Punkte eintragen
End With
Sheets("Archiv").Protect Password:="0000"
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
Gruß
Ich
|