Option Explicit
Sub Demo()
Dim c As Range, rngFilter As Range
Dim strCriteria As String
ThisWorkbook.Sheets.Add
For Each c In Range("A2:A4")
c.Value = "A" & Format(c.Row, "000")
Next c
ActiveSheet.UsedRange.Copy Destination:=Range("A6")
ActiveSheet.UsedRange.Copy Destination:=Range("A11")
Range("A1").Value = "Filter": Range("B1").Value = "Wert"
strCriteria = Cells(WorksheetFunction.RandBetween(2, 4), 1).Text
ActiveSheet.UsedRange.AutoFilter
ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=strCriteria
Set c = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set rngFilter = c.SpecialCells(xlCellTypeVisible)
For Each c In rngFilter
c.EntireRow.Interior.Color = RGB(230, 230, 230)
c.Offset(, 1).Value = strCriteria
Next c
ActiveSheet.UsedRange.AutoFilter
End Sub