Da der Code keine MSGBox startet, muss das als Workbook.Open-Event passieren. Deshalb Öffnen ohne Makros:
Sub Einlesen()
Dim WB As Workbook
Dim WS As Worksheet: Set WS = ActiveSheet
Dim f As String
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Pfad = "H:\Optiko\Projektantraege\"
f = Dir(Pfad & "*.xlsx")
Do While Len(f)
Set WB = Workbooks.Open(Pfad & f)
WB.Sheets("Projektantrag").Range("B4:B97").Copy
WS.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Transpose:=True
WB.Close 0
f = Dir
Loop
End Sub