VBA · Administration

Alte Datensätze nach Datum archivieren

Verschiebt Zeilen mit Datum vor einem Grenzwert in ein Archivblatt.

VBA
Sub AlteZeilenArchivieren()
    Dim src As Worksheet, arc As Worksheet, letzte As Long, i As Long, grenze As Date, ziel As Long
    Set src = ActiveSheet
    grenze = DateAdd("m", -12, Date)
    On Error Resume Next
    Set arc = Worksheets("Archiv")
    On Error GoTo 0
    If arc Is Nothing Then
        Set arc = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        arc.Name = "Archiv"
        src.Rows(1).Copy arc.Rows(1)
    End If
    letzte = src.Cells(src.Rows.Count, "A").End(xlUp).Row
    For i = letzte To 2 Step -1
        If IsDate(src.Cells(i, "A").Value) Then
            If CDate(src.Cells(i, "A").Value) < grenze Then
                ziel = arc.Cells(arc.Rows.Count, "A").End(xlUp).Row + 1
                src.Rows(i).Copy arc.Rows(ziel)
                src.Rows(i).Delete
            End If
        End If
    Next i
End Sub
VBAExcelArchivAdministration
WA