Option Explicit
Sub test()
Dim datEINGABE As Date
Dim rngSUCHE As Excel.Range
Dim lngLaufZahl As Long
Dim lngLaufendeZeile As Long
Dim wbQUELL As Excel.Workbook
Dim lngZielSpalte As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
datEINGABE = CDate(Application.InputBox("Datum eingeben:", "Datum", , , , , , 2))
lngLaufendeZeile = 5
For Each wbQUELL In Workbooks
If wbQUELL.Name <> ThisWorkbook.Name Then
wbQUELL.Activate
Set rngSUCHE = wbQUELL.Sheets("Time Tracking").Cells.Find(datEINGABE)
If Not rngSUCHE Is Nothing Then
lngZielSpalte = rngSUCHE.Column
ThisWorkbook.Worksheets("Master").Cells(lngLaufendeZeile, 1) = wbQUELL.Name
ThisWorkbook.Worksheets("Master").Cells(lngLaufendeZeile, lngZielSpalte) = wbQUELL.Worksheets("Time Tracking").Cells(Rows.Count, lngZielSpalte).End(xlUp)
lngLaufendeZeile = lngLaufendeZeile + 1
End If
End If
Next
Set rngSUCHE = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub