Thema: Verschieben von Zeilen per VBA bei Öffnen

Hallo zusammen,
ich wende mich vertrauensvoll an Euch Fachleute, da ich Hilfe bei einem Makro benötige. Folgende Funktion soll in eine Datei eingebaut werden: Bei Öffnen des Dokuments soll automatisch eine Routine ablaufen, die prüft, ob ein Datensatz älter als 365 Tage ab einem in einer Spalte eingetragenen Datum ist. Falls ja, soll die komplette Zeile in Tabellenblatt 2 verschoben werden. Ggf. entstehende Leerzeilen in Tabellenblatt 1 sollen gelöscht werden, das Einfügen der Zeilen in Tabellenblatt 2 soll untereinander chronologisch erfolgen.
Rudimentäre Beispieldatei: https://www.herber.de/bbs/user/98567.xlsx
Vielen Dank vorab und einen schönen Tag.
Viele Grüße
Uwe

Hallo Uwe,
in des Modul "DieseArbeitsmappe".

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
  Dim rng As Range, rngC As Range
  Dim lngLast As Long
  
  With Tabelle1
    lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
    For Each rng In .Range("D3:D" & lngLast)
      If IsDate(rng) Then
        If rng < Date - 365 Then
          If rngC Is Nothing Then
            Set rngC = rng.EntireRow
          Else
            Set rngC = Union(rngC, rng.EntireRow)
          End If
        End If
      End If
    Next
  End With
  
  With Tabelle2
    If Not rngC Is Nothing Then
      lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
      rngC.Copy .Cells(lngLast + 1, 1)
      rngC.Delete
    End If
  End With
  
  Set rng = Nothing
  Set rngC = Nothing
End Sub

Hallo Sepp,
vielen Dank!!! Funktioniert einwandfrei, genau so wie ich es mir vorgestellt hatte!!! Vielen Dank für die schnelle Hilfe! Ich habe an meiner Datei schon etwas weitergebastelt und fürchte, dass ich hierzu noch weitere Unterstützung von euch benötigen werde. Ich würde dafür allerdings einen neuen Thread eröffnen, da es sich um eine gänzlich andere Funktion/Anwendung innerhalb der Datei handelt. Falls ich in diesem Thread weitermachen soll, bitte Bescheid geben.
Danke nochmals an Sepp und viele Grüße
Uwe

Hallo zusammen,
ich wende mich vertrauensvoll an Euch Fachleute, da ich Hilfe bei einem Makro benötige. Folgende Funktion soll in eine Datei eingebaut werden: Bei Öffnen des Dokuments soll automatisch eine Routine ablaufen, die prüft, ob ein Datensatz älter als 365 Tage ab einem in einer Spalte eingetragenen Datum ist. Falls ja, soll die komplette Zeile in Tabellenblatt 2 verschoben werden. Ggf. entstehende Leerzeilen in Tabellenblatt 1 sollen gelöscht werden, das Einfügen der Zeilen in Tabellenblatt 2 soll untereinander chronologisch erfolgen.
Rudimentäre Beispieldatei: https://www.herber.de/bbs/user/98567.xlsx
Vielen Dank vorab und einen schönen Tag.
Viele Grüße
Uwe

Hallo Uwe,
in des Modul "DieseArbeitsmappe".

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
  Dim rng As Range, rngC As Range
  Dim lngLast As Long
  
  With Tabelle1
    lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
    For Each rng In .Range("D3:D" & lngLast)
      If IsDate(rng) Then
        If rng < Date - 365 Then
          If rngC Is Nothing Then
            Set rngC = rng.EntireRow
          Else
            Set rngC = Union(rngC, rng.EntireRow)
          End If
        End If
      End If
    Next
  End With
  
  With Tabelle2
    If Not rngC Is Nothing Then
      lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
      rngC.Copy .Cells(lngLast + 1, 1)
      rngC.Delete
    End If
  End With
  
  Set rng = Nothing
  Set rngC = Nothing
End Sub

Hallo Sepp,
vielen Dank!!! Funktioniert einwandfrei, genau so wie ich es mir vorgestellt hatte!!! Vielen Dank für die schnelle Hilfe! Ich habe an meiner Datei schon etwas weitergebastelt und fürchte, dass ich hierzu noch weitere Unterstützung von euch benötigen werde. Ich würde dafür allerdings einen neuen Thread eröffnen, da es sich um eine gänzlich andere Funktion/Anwendung innerhalb der Datei handelt. Falls ich in diesem Thread weitermachen soll, bitte Bescheid geben.
Danke nochmals an Sepp und viele Grüße
Uwe