löscht Spalten nicht

[Kuwer]

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

[IchBinIch]

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

[artcreativity]

Guten Morgen,

habe den neuen Code eingefügt aber es klappt leider überhaupt nicht.

danke

Annette

[IchBinIch]

Hallo Annette,

wie hast Du das denn genau gemacht?


Gruß 
Ich

[artcreativity]

habe den Sverweis geändert

danke

Annette

[IchBinIch]

Der Code von Uwe funktionierte bei meinem Test einwandfrei in Deiner Datei.
Da muss irgendetwas schief gegangen sein.

[artcreativity]

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

[IchBinIch]

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".

[artcreativity]

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

[IchBinIch]

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