Vielen Dank für deine Mühe, aber irgendwie steige ich da nicht mehr durch. Hab es jetzt so und das funktioniert ja auch soweit...
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 'einfügen in die nächste freie Zelle
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
Damit wird, wie gesagt, nur in die letzte Zeile das Datum geschrieben und nicht von der ersten bis zur letzten. Evtl. kann man ja den Range var. anpassen. Evtl. hilft es ja auch, dass die Daten nach dem Einfügen immer selektiert sind. Vielleicht kann da was über selektion machen...
Bin da aber mit meinem Latein am Ende.
|