AW: hierzu ...
14.06.2020 23:11:39
fcs
Hallo Michael,
deine ursprünhliche Frage war unklar formuliert.
Dabei dürfen nur Zeilen übernommen werden, bei denen der Wert in der Spalte "Austritt zum" kleiner als das aktuelle Datum ist.
Nach deiner Beispieldatei möchtest du die Zeilen übernehmen in denen bei Austrittsdatum nichts eingetragen ist oder >= dem aktuellen Datum ist.
Ich hab meine Vorschlag für das Makro mal angepasst.
Wenn du das ganze manuell lösen willst,dann musst du wie follgt vorgehen:
1. Markiere alle Daten im Blatt inklusive der Titelzeile.
2. Aktiviere im Menü "Daten" den Autofilter
3. Setze den Filter für die Spalte "Austrittsdatum" (Datumsfilter benutzerdefiniert)
4. Wenn Nicht in allen Zeilen Namen eingetragen sind, dann setze zusätzlich den Filter für die Spalte "Name"
5. Sortiere die Liste nach den Spalten Name und Vorname
6. Markiere die Zellen, die kopiert werden sollen, kopiere die Zellen und füge die Daten im gewünschten Blatt ein.
7. Lösche in der Liste die Filter, sortiere die Liste nach der "M-Nr." und deaktiviere den AUtofilter wieder.
LG
Franz
'Makro in einem allgemeine Modul deiner persönlichen Makroarbeitsmappe einfügen
Sub prcMA_liste_Filtern_sortieren()
Dim wks As Worksheet, wksNeu As Worksheet
Dim rngData As Range
Dim spaDatum As Long
If MsgBox("Daten nach Eintrittsdatum filtern und sortiert in neues Blatt kopieren?", _
vbQuestion + vbOKCancel, "MA-Liste filtern") = vbCancel Then Exit Sub
Set wks = ActiveSheet
spaDatum = 7 'Spalte G
With wks
'AUtofilter einrichten
Set rngData = .UsedRange
If .AutoFilterMode = True Then
If .FilterMode = True Then
.ShowAllData
End If
.AutoFilterMode = False
End If
'Daten nach Austrittsdatum filtern (>= Heute ODER Leer)
rngData.AutoFilter Field:=spaDatum, Criteria1:=">=" & CLng(Date), _
Operator:=xlOr, Criteria2:=""
'Daten nach Name filtern ( Leer)
rngData.AutoFilter Field:=4, Criteria1:=""
'Daten nach Nachname, Vorname sortieren
rngData.Sort key1:=.Range("D1"), order1:=xlAscending, _
key2:=.Range("C1"), order2:=xlAscending, Header:=xlYes
End With
'Neues Tabellenblatt einfügen
ActiveWorkbook.Worksheets.Add after:=wks
Set wksNeu = ActiveSheet
'Gefilterte Daten kopieren
rngData.Copy
With wksNeu
'Spaltenbreiten übertragen
.Range("B1").PasteSpecial Paste:=xlPasteColumnWidths
'Daten einfügen
.Range("B1").PasteSpecial Paste:=xlPasteAll
End With
'Autofilter deaktivieren und Daten nach M-Nr. sortieren
With wks
Set rngData = .UsedRange
.ShowAllData
.AutoFilterMode = False
rngData.Sort key1:=.Range("B1"), order1:=xlAscending, Header:=xlYes
End With
End Sub