Gruppe
Allgemein
Problem
Alle Datensätze, deren Datum in Spalte A öfter als 3 mal vorkommen, sollen in eine neue Arbeitsmappe kopiert werden.
StandardModule: Modul1
Sub MatchCopy()
Dim rng As Range, rCell As Range
Dim iRow As Integer
Set rng = Range("A1").CurrentRegion
Workbooks.Add 1
For Each rCell In rng.Columns(1).Cells
If WorksheetFunction.CountIf(rng.Columns(1), rCell.Value) > 3 Then
iRow = iRow + 1
rng.Rows(rCell.Row).Copy Cells(iRow, 1)
End If
Next rCell
If IsEmpty(Range("A1")) Then
ActiveWorkbook.Close savechanges:=False
Beep
MsgBox "Keine Datensätze gefunden!"
Else
Columns.AutoFit
End If
End Sub