For
Each
file
In
Application.GetOpenFilename(MultiSelect:=
True
)
Workbooks.Open file
Selection.Copy
datum = Mid(Range(
"A3"
), 43, 10)
ThisWorkbook.Worksheets(
"Tabelle1"
).Activate
Range(
"B"
& Cells(Rows.Count, 2).
End
(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False
, Transpose:=
True
Dim
rng
As
Excel.Range
With
Worksheets(
"Tabelle1"
)
Set
rng = .Range(
"B"
& Cells(Rows.Count, 2).
End
(xlUp).Row, .Cells(.Rows.Count,
"B"
).
End
(xlUp))
End
With
With
rng.Offset(, -1)
.FormulaR1C1 = datum
End
With
Next