Daten aus verschiedenen Datein extrahieren

Sub SuchSammelTest()
' SuchSammelTest Makro
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "\\gwdu119.gwdg.de\wilhelm.kluemper\_STUDsys\Desktop\sammeltrans-rename-   _
_
_
_
test"
.FileType = msoFileTypeAllFiles
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount),  _
UpdateLinks:=0)
'DO YOUR CODE HERE
Windows(wbResults).Activate
Sheets("drop-down entries").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("SammelMakro.xlsm").Activate
Sheets("testtest").Select
Range("A1").Select
Selection.End(xlToRight).Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub