|
Einmal kompliziert und geschmacklos
Sub TestIt()
Dim Wsh As Worksheet
Dim dateien, x, r
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
Wsh.Cells(1).Value = .Parent.Name
.UsedRange.Copy Wsh.Cells(2)
.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
Workbooks.Open dateien(x), local:=True
With ActiveSheet
Wsh.Cells(r, 1).Value = .Parent.Name
.UsedRange.Offset(2).Copy Wsh.Cells(r, 2)
.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
|