Herbers Excel/VBA-Archiv
| Informationen und Beispiele zum Thema MsgBox | |
|---|---|
 Screenshot zu MsgBox |
MsgBox-Seite mit Beispielarbeitsmappe aufrufen |
Übernahme von Daten
- Übernahme von Daten von Gero Becker vom 08.09.2020 08:25:54
- AW: Übernahme von Daten - von Herbert_Grom am 08.09.2020 09:31:00
- AW: Übernahme von Daten - von Gero Becker am 08.09.2020 10:14:52
- AW: Übernahme von Daten - von Gero Becker am 08.09.2020 10:14:52
- AW: Übernahme von Daten - von fcs am 08.09.2020 10:35:16
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
von: Herbert_Grom
Geschrieben am: 08.09.2020 09:31:00
Hallo Gero,
sollen die übertragenen Daten dann aus "Übergabe" gelöscht werden?
Servus
von: Gero Becker
Geschrieben am: 08.09.2020 10:14:52
ja bitte :)
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