20.05.2022, 14:50
Hallo an Alle,
seit Jahren arbeite ich mit einer Datei, darin mitlerweile eine Menge Seiten und Makros,
Seit einer Woche jedoch geht es nicht mehr.
Zu erst habe ich den PC zurückgesetzt, aber kein Erfolg.
Dann habe ich die Datei zurück gebaut, also die Makros die laufen, gelöscht usw.
Dadurch bleibt jetzt nur ein kleiner aber entscheidener Teil übrig
Dabei ist mir aufgefallen, dass es der Teil ist, den ich schon vor etlichen Jahren geschrieben habe (mein aller Erstes und auch nur mit Hilfe).
Nach Googlesuche bin darauf getossen, dass das vielleicht ein Rest von Makro 4.0 enthalten könnte.
Habe zwar in den Einstellung der Makro alles geändert, aber trotzdem läuft es nicht.
Aber ich kann nicht erkennen, wo man das sieht, denn debuggen zeigt keine Fehler an.
(Ich arbeite mit Windows10, Excel 2019, bin kein Genie nur Anfänger mit Mut Neues zu probieren.)
Vielleicht kann hier mir jemand helfen.
Datei ist angehangen, jedenfalls der Teil , der nicht läuft.
Folgenden Code habe ich in einem Modul:
Sub EintragungenUebernehmen() 'überträgt die Daten aus der Eingabemaske direkt auf Blatt Artikel als Zu- oder Abgang
Dim varZeile As Variant
If Not IsEmpty(Range("D4")) And (Not IsEmpty(Range("E18")) Or Not IsEmpty(Range("E20"))) Then
With Worksheets("1")
If .FilterMode Then .ShowAllData
varZeile = Application.Match(Range("D4").Value, .Columns(1), 0)
If Not IsError(varZeile) Then
With .Cells(varZeile, 6)
Sheets("1").Unprotect Password:="0000"
.Value = .Value - Range("E18").Value + Range("E20").Value 'E 18 = Abgang / E20 = Zugang
End With
Else
MsgBox "Die Artikelnummer " & Range("D4").Value & " wurde nicht gefunden.", vbInformation
End If
End With
Call kopieren
With Worksheets("1")
Range("D4,E18,E20,H18,H20") = ""
Range("D4,E18,E20,H18,H20").Select
Sheets("Eingabemaske").Select 'Blatt Eingabemaske auswählen
Range("D4:H4,H18,H20").Select 'Auswahl Feld D4:H4 und H18+H20
Selection.ClearContents 'es werden Daten gelöscht in D4:H4 und H18+H20
End With
End If
End Sub
Sub kopieren()
Dim LoLetzte As Long
Sheets("3").Unprotect Password:="0000" 'PW identisch mit PW Blattschutz
With Worksheets("3")
LoLetzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(LoLetzte, 4) = Sheets("Eingabemaske").Cells(20, 5) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 1) = Sheets("Eingabemaske").Cells(4, 4) 'überträgt
.Cells(LoLetzte, 3) = Sheets("Eingabemaske").Cells(18, 5) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 2) = Sheets("Eingabemaske").Cells(6, 4) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 6) = Sheets("Eingabemaske").Cells(18, 8) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 5) = Sheets("Eingabemaske").Cells(4, 10) 'überträgt
.Cells(LoLetzte, 7) = Sheets("Eingabemaske").Cells(20, 8) 'wird leider derzeitig nicht übertragen
End With
Sheets("3").Protect Password:="0000"
End Sub
seit Jahren arbeite ich mit einer Datei, darin mitlerweile eine Menge Seiten und Makros,
Seit einer Woche jedoch geht es nicht mehr.
Zu erst habe ich den PC zurückgesetzt, aber kein Erfolg.
Dann habe ich die Datei zurück gebaut, also die Makros die laufen, gelöscht usw.
Dadurch bleibt jetzt nur ein kleiner aber entscheidener Teil übrig
Dabei ist mir aufgefallen, dass es der Teil ist, den ich schon vor etlichen Jahren geschrieben habe (mein aller Erstes und auch nur mit Hilfe).
Nach Googlesuche bin darauf getossen, dass das vielleicht ein Rest von Makro 4.0 enthalten könnte.
Habe zwar in den Einstellung der Makro alles geändert, aber trotzdem läuft es nicht.
Aber ich kann nicht erkennen, wo man das sieht, denn debuggen zeigt keine Fehler an.
(Ich arbeite mit Windows10, Excel 2019, bin kein Genie nur Anfänger mit Mut Neues zu probieren.)
Vielleicht kann hier mir jemand helfen.
Datei ist angehangen, jedenfalls der Teil , der nicht läuft.
Folgenden Code habe ich in einem Modul:
Sub EintragungenUebernehmen() 'überträgt die Daten aus der Eingabemaske direkt auf Blatt Artikel als Zu- oder Abgang
Dim varZeile As Variant
If Not IsEmpty(Range("D4")) And (Not IsEmpty(Range("E18")) Or Not IsEmpty(Range("E20"))) Then
With Worksheets("1")
If .FilterMode Then .ShowAllData
varZeile = Application.Match(Range("D4").Value, .Columns(1), 0)
If Not IsError(varZeile) Then
With .Cells(varZeile, 6)
Sheets("1").Unprotect Password:="0000"
.Value = .Value - Range("E18").Value + Range("E20").Value 'E 18 = Abgang / E20 = Zugang
End With
Else
MsgBox "Die Artikelnummer " & Range("D4").Value & " wurde nicht gefunden.", vbInformation
End If
End With
Call kopieren
With Worksheets("1")
Range("D4,E18,E20,H18,H20") = ""
Range("D4,E18,E20,H18,H20").Select
Sheets("Eingabemaske").Select 'Blatt Eingabemaske auswählen
Range("D4:H4,H18,H20").Select 'Auswahl Feld D4:H4 und H18+H20
Selection.ClearContents 'es werden Daten gelöscht in D4:H4 und H18+H20
End With
End If
End Sub
Sub kopieren()
Dim LoLetzte As Long
Sheets("3").Unprotect Password:="0000" 'PW identisch mit PW Blattschutz
With Worksheets("3")
LoLetzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(LoLetzte, 4) = Sheets("Eingabemaske").Cells(20, 5) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 1) = Sheets("Eingabemaske").Cells(4, 4) 'überträgt
.Cells(LoLetzte, 3) = Sheets("Eingabemaske").Cells(18, 5) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 2) = Sheets("Eingabemaske").Cells(6, 4) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 6) = Sheets("Eingabemaske").Cells(18, 8) 'wird leider derzeitig nicht übertragen
.Cells(LoLetzte, 5) = Sheets("Eingabemaske").Cells(4, 10) 'überträgt
.Cells(LoLetzte, 7) = Sheets("Eingabemaske").Cells(20, 8) 'wird leider derzeitig nicht übertragen
End With
Sheets("3").Protect Password:="0000"
End Sub