Option Explicit
Sub Test01()
Const sEXT As String = "XLSX"
Const sPFAD As String = "c:\Test2\"
Dim fil As Variant
With CreateObject("Scripting.FileSystemObject")
For Each fil In .GetFolder(sPFAD).Files
If UCase$(.GetExtensionName(fil.Path)) = sEXT Then
Call CopyAndPasteValuesFrom(fil.Path)
End If
Next
End With
End Sub
Function CopyAndPasteValuesFrom(ByRef sWKB As String) As Boolean
Dim wkbQuelle As Excel.Workbook
Set wkbQuelle = Workbooks.Open(sWKB)
wkbQuelle.Worksheets("Z-ESR Dia").Range("P37").Copy
wkbQuelle.Close SaveChanges:=False
Set wkbQuelle = Nothing
End Function