nach Autofilter Markierung

Hallo nochmal!
Wie kann ich erreichen, dass die Dateien, die nach Auswahl des Filters (z.B. alle Dateien aus Ordner xxx) gleichzeitig genau die angezeigten Datein markiert werden. Sinn ist es diese dann in ein anderes Tabellenblatt zu übertragen. Ich habe schon ein Makro geschrieben, das mir die markierten Zellen überträgt, aber die Markierung ist leider jedesmal manuell durchzuführen.
Hier nochmal der Code:

Sub NeuEinlesen()
Set MyShell = CreateObject("wscript.shell")
Set MyFiles = CreateObject("Scripting.FileSystemObject")
Set Appshell = CreateObject("Shell.Application")
On Error Resume Next
Set AppFolder = Appshell.BrowseForFolder(0, "", &H1, 17)
verz = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
If Err.Number > 0 Then
i = InStr(AppFolder, ":")
verz = Mid(AppFolder, i - 1, 1) & ":\"
End If
If verz = "" Then Exit Sub
If n = 0 Then
Range("A3").Select
Range(Selection, Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
End If
Set drive = MyFiles.GetFolder(verz)
Set dat = drive.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = drive.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
Next
Search drive
For x = 1 To n
Cells(x + 2, 1).Value = MyFiles.GetBaseName(dpfad(x))
Cells(x + 2, 2).Value = MyFiles.GetExtensionName(dpfad(x))
Cells(x + 2, 4).Value = dordner(x)
Cells(x + 2, 5).Value = Int(dsize(x) / 1024)
Cells(x + 2, 6).Value = DateValue(Date) - DateValue(dcreated(x))
Cells(x + 2, 7).Value = DateValue(Date) - DateValue(dlast(x))
Cells(x + 2, 8).Value = dpfad(x)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x + 2, 9), Address:= _
dpfad(x), TextToDisplay:=dname(x)
Next
Application.ScreenUpdating = True
m = MsgBox(n & " Dateien eingetragen." & Chr(13) & "Weitere Daten hinzufügen?", 4)
If m = 6 Then NeuEinlesen
Range("A3").Select
Range(Selection, Cells.SpecialCells(xlCellTypeLastCell)).Select
Selection.Sort key1:=Range("D3"), order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, header:=xlNo
Range("A2:I2").Select
With Worksheets("Tabelle1")
If Not .AutoFilterMode Then
Selection.AutoFilter
End If
End With
Range("A2").Select
n = 0
End Sub

Sub Search(ByVal StartFolder)
Set Weitere = StartFolder.SubFolders
For Each AktuellerOrdner In Weitere
Set dat = AktuellerOrdner.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = AktuellerOrdner.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
Next
Search AktuellerOrdner
Next
End Sub

Vielen Dank für Eure Hilfe im Voraus!
mfg Painold Thomas (daher auch der nickname pain007 hat nix mit Schmerz zu tun, sondern mit meinem Namen :-) )