Sub TastIt()
Dim Wsh As Worksheet
Dim dateien, x, r, c
dateien = Application.GetOpenFilename _
("txt-Dateien (*.txt), *.txt", MultiSelect:=True)
If IsArray(dateien) Then
Application.ScreenUpdating = False
Set Wsh = ThisWorkbook.ActiveSheet
Wsh.Cells.Clear
On Error GoTo TheEnd
Workbooks.Open dateien(1), local:=True
With ActiveSheet
.UsedRange.Copy Wsh.Cells(2)
Range(Wsh.Cells(3, 2), Wsh.Cells(3, 2).End(xlDown)).Offset(, -1).Value = .Parent.Name
.Parent.Close False
End With
For x = 2 To UBound(dateien)
With Wsh
r = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row + 1
c = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Column
Workbooks.Open dateien(x), local:=True
With ActiveSheet
.UsedRange.Offset(2).Copy Wsh.Cells(r, 2)
Range(Wsh.Cells(r, c), Wsh.Cells(r, c).End(xlDown)).Offset(, 1 - c).Value = .Parent.Name
.Parent.Close False
End With
End With
Next x
On Error GoTo 0
TheEnd:
If ActiveWorkbook.Name <> ThisWorkbook.Name Then ActiveWorkbook.Close False
Set Wsh = Nothing
Application.ScreenUpdating = True
End If
End Sub
Es ist so, dass die Daten in dem Dateinamen durch Unterschriche getrennt sind (nach TIME sogar 2 Unterstriche). So z.B.
1071489_SN_0385763KBL3D_Gramm_5°C_40grad_7ml_Time__20_11_2018_14_23_49.txt
Wie kann ich in dem Makro einfügen, dass die einzelnen Daten in jeweils eine eigene Spalte eingetragen werden?