Option
Explicit
Const
strPath
As
String
= "C:\Flexsim\Makros\PILOT_STUDY_1\"
Sub
Main()
Dim
strDateiname
As
String
Dim
wkbBook
As
Workbook
Dim
lngLastRowQ
As
Long
Dim
lngLastRowZ
As
Long
Dim
lngLastCol
As
Long
Dim
intCalc
As
Integer
Dim
LetzteZeile
As
Long
On
Error
GoTo
Fin
With
Application
.ScreenUpdating =
False
.AskToUpdateLinks =
False
.EnableEvents =
False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts =
False
End
With
strDateiname = Dir$(strPath &
"*.csv"
)
Do
While
strDateiname <>
""
If
strDateiname <> ThisWorkbook.Name
Then
Set
wkbBook = Workbooks.Open(strPath & strDateiname)
Range(
"E4373"
).
Select
ActiveCell.FormulaR1C1 =
"=AVERAGE(R[-4371]C[-2]:RC[-2])"
Range(
"E4373"
).
Select
Selection.AutoFill Destination:=Range(
"E4373:F4373"
), Type:=xlFillDefault
Range(
"E4373:F4373"
).
Select
Selection.Copy
Windows(
"Auswertung_PCSimon.xlsm"
).Activate
LetzteZeile = Cells(Rows.Count, 4).
End
(xlUp).Row
Range(
"D"
& LetzteZeile + 1).
Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False
, Transpose:=
False
wkbBook.Close
True
Set
wkbBook =
Nothing
End
If
strDateiname = Dir$()
Loop
Fin:
Set
wkbBook =
Nothing
With
Application
.ScreenUpdating =
True
.AskToUpdateLinks =
True
.EnableEvents =
True
.Calculation = intCalc
.DisplayAlerts =
True
End
With
If
Err.Number <> 0
Then
MsgBox
"Error: "
& _
Err.Number &
" "
& Err.Description
End
Sub