Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1576to1580
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatische Archivierung

Automatische Archivierung
11.09.2017 13:39:20
Sabine
Hallo zusammen,
ich bin ein absoluter VBA-Neuling, habe aber gerade die Aufgabe erhalten, komplette Zellen in Excel zu archivieren, sobald eine Zelle den Wert "erledigt" erhält. Ich habe hierzu zwar schon ein paar Ansätze online gefunden, allerdings funktioniert es noch nicht und ich finde meinen Fehler nicht.
Folgenden VBA-Code habe ich mir von Eurer Seite kopiert und (hoffentlich richtig) angepasst:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
If Not (Target.Column = 11 And _
Target.Row > 1) Then GoTo leave_sub
On Error GoTo leave_sub
If LCase(Target.Value) = "erledigt" Then
lRow = Sheets("Archiv_Overview").Range("K" & Sheets("Archiv_Overview").Rows.Count).End(  _
_
xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Copy
Sheets("Archiv_Overview").Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
Target.EntireRow.Delete (xlUp)
MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv"
End If
leave_sub:
End Sub

Wenn ich den VBA-Code laufen lasse, erscheint bei mir der Laufzeitfehler 424 ("Objekt erforderlich").
Zur Tabelle an sich: In zwei verschiedenen Tabellenblättern werden Projektdaten eingetragen. Auf dem Tabellenblatt "Overview" sind generelle Informationen, wie Projektname, Start, Ende, zuständige Person etc. enthalten. Hier gibt es die Spalte K in der per Formel eingetragen wird, wann ein Projekt beendet ist ("erledigt"). Sobald das Projekt auf "erledigt" steht, soll es automatisch in das Tabellenblatt "Archiv_Overview" verschoben werden.
Im zweiten Tabellenblatt sind noch weitere Informationen zu den Projekten enthalten. Hier sollen erledigte Projekte natürlich ebenfalls verschoben werden, aber ich denke, da könnte man den funktionierenden VBA nehmen und entsprechend anpassen?
Ganz ganz vielen lieben Dank für Eure Hilfe!
Sabine

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Archivierung
11.09.2017 13:49:19
ChrisL
Hi Sabine
Der Code ist OK. Bitte lade eine Beispieldatei ins Forum.
Interessant wäre auch wo der Debugger stehen bleibt. Weil der Code ein Fehlerhandling enthält, kann die beschriebene Fehlermeldung eigentlich gar nicht erscheinen.
cu
Chris
AW: Automatische Archivierung
12.09.2017 07:44:16
Sabine
Hi Chris,
hier mal eine Beispielsdatei: https://www.herber.de/bbs/user/116185.xlsm
Der Code blieb gestern bei
If Not (Target.Column = 11 And _ Target.Row > 1) Then GoTo leave_sub
stehen.
Ich habe den Code auch in die Beispielsdatei eingefügt und da tut er derzeit gar nichts. Sobald ich auf "Play" drücke im VBA-Modus, soll ich ein neues Makro erstellen (?).
Ich weiß nicht ob das wichtig ist für die Programmierung, aber wenn etwas in das Tabellenblatt Archiv_Overview kopiert werden soll, ist dort die erste freie Zelle die Nr. 8.
Lieben Dank
Sabine
Anzeige
erste Analyse ...
12.09.2017 07:58:37
Matthias
Hallo Sabine
Das funktioniert nicht weil Du in Spalte(K) also(11)
die Strings "erledigt" und "laufend" bzw. ("" also leer) per Formel ermittelst.
Würdest Du erledigt selbst in die Zelle schreiben greift auch der Code.
Gruß Matthias
AW: 2. Analyse ...
12.09.2017 08:24:42
Gerd
Hallo Sabine!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 10 And Target.Row > 1 Then
Application.EnableEvents = False
If LCase(Target.Offset(0, 2).Value) = "erledigt" Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Copy
Sheets("Archiv_Overview").Range("K" & Sheets("Archiv_Overview"). _
Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Target.EntireRow.Delete (xlUp)
MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv"
End If
Application.EnableEvents = True
End If
End Sub

Gruß Gerd
Anzeige
AW: 2. Analyse ...
12.09.2017 08:31:10
Sabine
Hi Gerd,
vielen Dank für den neuen Code! Eine Verständnisfrage. Bezieht sich
If Not Target.Column = 10 And Target.Row > 1 Then
auf Spalte J? Da trage ich ja quasi nur die "Gesundheit" des Projekts ein. Müsste es sich nicht auf die Spalte I beziehen, wo ich den Status des Projekts eintrage und sich entsprechend der Balken zieht?
LG
Sabine
AW: 2. Analyse ...
12.09.2017 08:36:26
Gerd
Ja!
If Target.Column = 9 And Target.Row > 1 Then

solte es genauso tun.
Gruß Gerd
AW: 2. Analyse ...
12.09.2017 08:57:18
Sabine
Hallo nochmal,
Ich habe nochmal die (wahrscheinlich total doofen) Anfänger-Fragen... danke für Eure Geduld!
ich habe eben den Code reinkopiert. Muss ich dann in der Spalte K einmal Enter drücken, damit der Datensatz archiviert wird? Ich habe unter anderem Spalte K geschützt, weil da eine Formel drin ist und ich kann nicht mehr draufklicken, sobald ich den Schutz aktiviert habe.
Könnte man auch einen Button bauen, auf den man klicken kann und der archiviert dann alles, was =100% ist?
Ich hoffe, das ist jetzt nicht was mega kompliziertes?
LG
Sabine
Anzeige
AW: andere Version ...
12.09.2017 09:08:09
Sabine
Hi Matthias,
in der Beispieldatei funktioniert es tadellos und tut genau das, was ich mir vorgestellt habe. Leider nur nicht in meiner eigentlichen Datei. Muss ich die Formel aus Spalte J rauslöschen (die, wo je nach Wert aus Spalte I erledigt, laufend etc. eingetragen wird), damit es funktioniert?
LG
Sabine
die Formeln aus K! löschen, in J sind doch Keine
12.09.2017 09:15:51
Matthias
Du kannst auch noch eine Abfrage einbauen, ob archiviert werden soll.
Das sehe dann so aus:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
On Error GoTo leave_sub
If Not Intersect(Target, Range("I8:I500")) Is Nothing And Target.Count = 1 Then
Select Case Target
Case 1 To 99
Target.Offset(, 2) = "laufend"
Case Is = 100
Target.Offset(, 2) = "erledigt"
Case Else
Target.Offset(, 2).ClearContents
End Select
If LCase(Target.Offset(, 2).Value) = "erledigt" Then
If MsgBox("Datensatz jetzt archivieren?", vbYesNo) = vbYes Then
lRow = Sheets("Archiv_Overview").Range("K" & Sheets("Archiv_Overview").Rows.Count).End( _
xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Copy
Sheets("Archiv_Overview").Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
Target.EntireRow.Delete (xlUp)
MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv"
End If
End If
End If
leave_sub:
End Sub
Gruß Matthias
Anzeige
AW: die Formeln aus K! löschen, in J sind doch Keine
12.09.2017 09:22:03
Sabine
Ich glaube ich habe meinen Fehler gefunden. Die Archivierung funktioniert nur, wenn der Blattschutz aufgehoben ist. Gibt es da ne Mögichkeit, dass der funktioniert, wenn der Blattschutz aktiv ist? Ich habe noch in anderen Spalten Formeln eingebaut und möchte möglichst verhindern, dass die rausgelöscht werden von den Nutzern.
Das mit der Abfrage ist ne tolle Idee, bau ich gleich mal ein.
Lieben Dank
Sabine
Unprotect / Protect
12.09.2017 09:32:57
Matthias
Hallo
Am Anfang vom Code: Activesheet.Unprotect PW
und am Ende wieder: Activesheet.Protect PW
Wobei PW für Dein PassWort steht, kannst Du aber auch weglassen, wenn Du kein PW vergibst.
gehe jetzt aber Offline. Viel Erfolg.
Gruß Matthias
Anzeige
AW: die Formeln aus K! löschen, in J sind doch Keine
12.09.2017 11:53:24
Sabine
Hallo nochmal,
es funktioniert alles prächtig, tausend Dank Euch :)
Nun musste ich eben noch eine weitere Spalte einfügen für die Durchnummerierung der PRojekte. Ich habe den Spaltenbezug im VBA auch entsprechend angepasst. Jetzt allerdings kopiert er alles rüber, bis auf den "erledigt" Status aus der jetzigen Spalte L (vorher K). Muss ich da noch etwas drin ändern?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
On Error GoTo leave_sub
If Not Intersect(Target, Range("J8:J500")) Is Nothing And Target.Count = 1 Then
Select Case Target
Case 1 To 99
Target.Offset(, 2) = "laufend"
Case Is = 100
Target.Offset(, 2) = "erledigt"
Case Else
Target.Offset(, 2).ClearContents
End Select
If LCase(Target.Offset(, 2).Value) = "erledigt" Then
If MsgBox("Datensatz jetzt archivieren?", vbYesNo) = vbYes Then
lRow = Sheets("Archiv_Overview").Range("K" & Sheets("Archiv_Overview").Rows.Count).End(  _
_
xlUp).Row + 1
ActiveSheet.Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Copy
Sheets("Archiv_Overview").Cells(lRow, 1).PasteSpecial Paste:=xlPasteValues
Target.EntireRow.Delete (xlUp)
MsgBox "Datensatz wurde archiviert!", vbOKOnly + vbInformation, "Archiv"
End If
End If
End If
leave_sub:
End Sub

Und noch eine weitere Frage. Das zweite Tabellenblatt (Further Information) bezieht sich ja mit weiteren Informationen auf die jeweiligen Projekte aus dem Tabellenblatt "Overview". Die sollen natürlich ebenfalls mit archiviert werden. Baue ich da den gleichen Code ein oder kann man das irgendwie miteinander verknüpfen, dass, wenn bspw. Projekt 1 aus Tabellenblatt Overview archiviert wird, auch das Projekt 1 aus dem Tabellenblatt "Further Information" mit archiviert wird?
Danke schön :)
LG
Sabine
Anzeige
statt Target.Offset(, 2) eben Target.Offset(, 1)
12.09.2017 16:43:26
Matthias
Hallo
Mit
If Not Intersect(Target, Range("J8:J500")) ...

sprichst Du ja nun die Spalte("J") an
Target.Offset(, 2) sind 2 Spalten nach rechts, das wäre dann Spalte("L")
Willst Du also weiterhin erledigt usw.... in Spalte("K") haben
so musst Du Offset ändern.
Von Target.Offset(, 2) eben auf Target.Offset(, 1)
Mit Deinen anderen Tabellenblättern habe ich mich nicht befasst.
Gruß Matthias
AW: statt Target.Offset(, 2) eben Target.Offset(, 1)
13.09.2017 08:53:47
Sabine
Hallo zusammen,
noch ein kurzes Update an Euch. es hat alles ganz hervorragend geklappt und funktioniert alles so wie es soll. Ich habe es gestern tatsächlich hingekriegt, den Code für das zweite Tabellenblatt selbst umzuschreiben, so dass er nun da funktioniert.
Nun habe ich noch ganz viele neue Ideen, aber die muss ich erst ein wenig ausformulieren. Zunächst einmal ganz herzlichen Dank und ich sende Euch nen virtuellen Kasten Bier als Danke schön :)
Bis bald
Sabine
Anzeige
AW: Automatische Archivierung
12.09.2017 08:17:01
ChrisL
Hi Sabine
Wie Matthias schon schrieb. Darum...
If Not (Target.Column = 9 And _ Target.Row > 1) Then GoTo leave_sub
cu
Chris
PS: Übrigens müsste es Archive_Overview oder Archiv_Übersicht heissen :P
AW: Automatische Archivierung
12.09.2017 08:26:28
Sabine
Hallo ihr Zwei,
vielen lieben Dank! Schade, dass es so nicht geht :) Danke auch für den Hinweis mit den Namen der Tabellenblätter, habe ich gerade mal geändert :)
Denke ich denn richtig, dass, wenn man den Code auf Spalte I umschreibt und dann sagt, wenn es = 100 ist, (dann wäre es ja in Spalte K als erledigt gekennzeichnet), dass es dann archiviert wird?
Liebe Grüße
Sabine
Anzeige
AW: Automatische Archivierung
12.09.2017 08:36:26
ChrisL
Hi Sabine
Habe übersehen, dass du hier auch noch ändern musst:
If LCase(Cells(Target.Row, 11)) = "erledigt" Then
cu
Chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige