Sub SearchAndCopyData()
Dim fso As Object, strFind As String, wsTarget As Worksheet, file As Object, sh As Worksheet, rngCol As Range, c As Range, firstAddress As String, dblKosten As String, strFolder As String, strHeader As Variant
strFolder = "Projekt Pfad"
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsTarget = Sheets(1)
strFind = InputBox("Bitte geben sie den Projektnamen an:", "Projektname suchen", "Projekt123")
If strFind <> "" Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wsTarget.Range("A2:X10000").Clear
For Each file In fso.GetFolder(strFolder).Files
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then
Set wbSearch = GetObject(file.Path)
For Each sh In wbSearch.Sheets
With sh.UsedRange
For Each strHeader In Array("Target")
Set rngCol = sh.UsedRange.Find(strHeader, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngCol Is Nothing Then Exit For
Next
If Not rngCol Is Nothing Then
Set c = .Find(strFind, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address