Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Übernahme von Daten

Betrifft: Übernahme von Daten von: Gero Becker
Geschrieben am: 08.09.2020 08:25:54

https://www.herber.de/bbs/user/140108.xlsm

Hallo Ihr lieben,

Ich würde gerne in der anhängenden Datei folgendes über den Sortieren Button Realisieren:

Wenn in dem Registerblatt "Übergabe" eine Aufgabe als erledigt steht und diese dann älter ist als 2 Wochen (im Vergleich mit dem Datum "Heute"), soll diese Im "Archiv" aufgelistet werden.

Vorab schonmal Vielen lieben Dank für Eure Hilfe

Betrifft: AW: Übernahme von Daten
von: Herbert_Grom
Geschrieben am: 08.09.2020 09:31:00

Hallo Gero,

sollen die übertragenen Daten dann aus "Übergabe" gelöscht werden?

Servus

Betrifft: AW: Übernahme von Daten
von: Gero Becker
Geschrieben am: 08.09.2020 10:14:52

ja bitte :)

Betrifft: AW: Übernahme von Daten
von: fcs
Geschrieben am: 08.09.2020 10:35:16

Hallo Gero,

nachfolgend ein entsprechendes Makro.
Die archivierten Zeilen werden im Blatt Übergabe gelöscht.
Wenn nicht gelöscht werden soll, dann die Zeile um markieren und die Zeile zum Löschen weglassen. Allerdings werden dann die älteren Zeilen jedes Mal kopiert und erscheinen im Archiv mehrfach.

LG
Franz
Sub Copy_to_Archiv()
  Dim wksQ As Worksheet, zeiQ As Long, zeiQL As Long, zeiQT As Long
  Dim wksZ As Worksheet, zeiZ As Long
  Dim StatusAutofilter As Boolean
  
  Set wksQ = ActiveWorkbook.Worksheets("Übergabe")
  Set wksZ = ActiveWorkbook.Worksheets("Archiv")
  zeiQT = 1 'Zeile mit den Spaltentiteln im Blatt Übergabe
  With wksZ
    zeiZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
  End With
  With wksQ
    StatusAutofilter = .AutoFilterMode
    If .AutoFilterMode = True Then
      If .FilterMode = True Then .ShowAllData
      zeiQ = .Cells(.Rows.Count, 1).End(xlUp).Row
    Else
      zeiQ = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range(.Rows(zeiQT), .Rows(zeiQ)).AutoFilter
    End If
    'Autofilter setzen
    'Spalte C (erledigt) = a
    .AutoFilter.Range.AutoFilter field:=3, Criteria1:="=a"
    'Spalte B (Festgestellt am) <= Heute - 14
    .AutoFilter.Range.AutoFilter field:=2, Criteria1:="<=" & CDbl(Date - 14)
    zeiQL = .Cells(.Rows.Count, 1).End(xlUp).Row
    If zeiQL = zeiQT Then
      MsgBox "Keine erledigten Einträge älter als 14 Tage"
    Else
      .Range(.Rows(zeiQT + 1), .Rows(zeiQL)).Copy Destination:=wksZ.Cells(zeiZ, 1)
      'in Spalte C der kopierten Zeilen WAHR eintragen, um archivierte Zeilen zu markieren
      .Range(.Cells(zeiQT + 1, 3), .Cells(zeiQL, 3)).Value = True
      .ShowAllData
      'Archivierte  Zeilen löschen
      .Range(.Cells(zeiQT + 1, 3), .Cells(zeiQ, 3)).SpecialCells(xlCellTypeConstants, _
         xlLogical).EntireRow.Delete
      
    End If
    If StatusAutofilter = False Then
      .AutoFilterMode = False
    End If
  End With
End Sub


Beiträge aus dem Excel-Forum zum Thema "Übernahme von Daten"