|
Noch komplizierter ....... ;-)
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
'Wsh.Cells(1).Value = .Parent.Name
.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
'Wsh.Cells(r, 1).Value = .Parent.Name
.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
|