Herbers Excel/VBA-Archiv

Mehrere Zeilen archivieren

• Mehrere Zeilen archivieren von Rita Z. vom 18.10.2020 20:36:16
• AW: Mehrere Zeilen archivieren - von Werner am 18.10.2020 21:21:58
• von Feedback... - von Werner am 22.10.2020 14:44:31

Betrifft: Mehrere Zeilen archivieren von: Rita Z.
Geschrieben am: 18.10.2020 20:36:16

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!

  

Betrifft: AW: Mehrere Zeilen archivieren
von: Werner
Geschrieben am: 18.10.2020 21:21:58

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

  

Betrifft: von Feedback...
von: Werner
Geschrieben am: 22.10.2020 14:44:31

Hallo,

...hast du wohl noch nichts gehört.

Gruß Werner

Beiträge aus dem Excel-Forum zum Thema "Mehrere Zeilen archivieren"