Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1788to1792
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

Mehrere Zeilen archivieren

Mehrere Zeilen archivieren
18.10.2020 20:36:16
Rita
Hallo liebe Excel-Gemeinde,
ich habe eine Excel-Tabelle in der ich regelmäßig Projekt-Daten eintrage (Tabellenblatt 1: Datenblatt).
Ich würde gerne, mit einem Button regelmäßig (z.B. wöchentlich) die Zeilen, die den Projektstatus "beendet" haben in das Tabellenblatt "Archiv" kopieren. Gleichzeitig sollen diese Zeilen aus dem Tabellenblatt "Datenblatt" gelöscht werden.
Im Archiv sollen somit nach und nach die beendeten Projekte gesammelt werden. Wichtig wäre, dass die in das Tabellenblatt "Archiv" kopierten Zeilen nicht beim nächsten Durchgang überschrieben werden.
Die Anzahl der beendeten Projekte ist bei jedem "Archivierungsvorgang" unterschiedlich.
Beispiel: In Woche 1 werden 3 Projekte beendet, dafür werden 5 neue Projekte in die Liste eingetragen. In Woche 2 werden 10 Projekte beendet, dafür werden 2 neue Projekte in die Liste eingetragen.
Bisher konnte ich das Problem nicht lösen, ohne die archivierten Zeilen zu überschreiben. Gerade das sollte ja nicht passieren.
Ich habe eine Beispieltabelle angefügt, die so ähnlich aussieht, wie meine Projekttabelle. https://www.herber.de/bbs/user/140961.xlsx
Ich hoffe es kann jemand behilflich sein und ggf. eine funktionierende Makro entwerfen.
Vielen Dank im Voraus!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Zeilen archivieren
18.10.2020 21:21:58
Werner
Hallo,
z.B. so:
Option Explicit
Sub Makro1()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Datenblatt")
If WorksheetFunction.CountIf(.Columns("H"), "beendet") = 0 Then Exit Sub
.ListObjects("Tabelle1").Range.AutoFilter Field:=8, Criteria1:="beendet"
With .ListObjects("Tabelle1").AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
End With
With Worksheets("Archiv")
loLetzte = .Columns("A").Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlPrevious).Offset(1).Row
If .Cells(10, "A") = "" Then loLetzte = 10
.Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValues
End With
With .ListObjects("Tabelle1").AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
End With
If .FilterMode Then .ShowAllData
End With
Application.CutCopyMode = False
End Sub
Gruß Werner
Anzeige
von Feedback...
22.10.2020 14:44:31
Feedback...
Hallo,
...hast du wohl noch nichts gehört.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige