Application.Filesearch - Ersatz

Sub Forecast_einlesen()
ApplicationUpdate = False
Application.Calculation = xlCalculationManual
Selection.AutoFilter 'Setzt den Autofilter zurück!
Range("A17:L17").Select 'Geht zum ersten Feld des Bereiches
Selection.AutoFilter 'Setzt neuen Autofilter, ohne zu selektieren
Dim Datname As Workbook, wksZiel As Worksheet, Monatsdateien() As Workbook
Dim iCounter As Integer, lZeileZiel As Long, wksquelle As Worksheet
Set Datname = ActiveWorkbook
Set wksZiel = Sheets("BASIC_forecasts ")
wksZiel.Select
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\Details-Forecast"
.SearchSubFolders = False
.Execute msoSortByFileType
.FileType = msoFileTypeExcelWorkbooks
ReDim Monatsdateien(1 To .FoundFiles.Count)
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open Filename:= _
.FoundFiles(iCounter) _
, UpdateLinks:=0
Set Monatsdateien(iCounter) = ActiveWorkbook
Next iCounter
End With
Datname.Activate
With wksZiel
.Range(.Cells(18, 1), .Cells(18, 1).End(xlDown).Offset(0, 11)).ClearContents
lZeileZiel = 18
For iCounter = 1 To UBound(Monatsdateien)
Set wksquelle = Monatsdateien(iCounter).Worksheets(2)
wksquelle.Range(wksquelle.Cells(19, 1), _
wksquelle.Cells(19, 1).End(xlDown).Offset(0, 11)).Copy
'      .Cells(lZeileZiel, 1).PasteSpecial Paste:=xlFormats
.Cells(lZeileZiel, 1).PasteSpecial Paste:=xlValues
lZeileZiel = .Cells(lZeileZiel, 1).End(xlDown).Row + 1
Application.CutCopyMode = False
Monatsdateien(iCounter).Close
Next
End With
ApplicationUpdate = True
Application.Calculation = xlCalculationAutomatic
Range("N19:O19").Select
Selection.Copy
Range("A18:B18").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("PIVOT_Forecast").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
End Sub

Sub Needs_einlesen()
Dim Datname As Workbook, datname1 As Workbook
Set Datname = ActiveWorkbook
Sheets("HU_NEEDS_CALCULATION").Activate
ActiveSheet.Unprotect Password:="GJ"
Dim datum As String, datumA As String
datumA = InputBox("Geben sie das heutige Datum ein (dd.mm.yyyy)")
If IsDate(datumA) Then
datum = Format(datumA, "dd.mm.yyyy")
Sheets("HU_NEEDS_CALCULATION").Select
Sheets("HU_NEEDS_CALCULATION").Copy
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\" & "SICHERUNGSKOPIEN\SICHERUNG_SUM_ETL_WAREHOUSE_" & datum & ". _
xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Datname.Activate
Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter
Range("A3:AL3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End If
Application.Workbooks.Open ThisWorkbook.Path & "\" & "Details-Needs\HU_NEEDS_" & datum & ".xls"
Set datname1 = ActiveWorkbook
Selection.RemoveSubtotal
ActiveWindow.LargeScroll ToRight:=1
Selection.AutoFilter Field:=37
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Datname.Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter Field:=37, Criteria1:="N"
Range("AL1").Select
ActiveCell.FormulaR1C1 = (datum)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowInsertingColumns:=True, AllowFiltering:=True, Password:="GJ"
datname1.Save
datname1.Close
Call Formel_schreiben
End Sub