Sub
importieren()
Dim
lngFreieZeile
As
Long
Dim
lngVorletzteZeile
As
Long
Dim
wbSRC
As
Excel.Workbook
Dim
wbTRG
As
Excel.Workbook
Dim
strSRC
As
String
On
Error
Resume
Next
strSRC = Application.GetOpenFilename(
"Text-Dateien (*.txt),*.txt"
, ,
"Textdatei auswählen..."
, ,
False
)
If
strSRC =
""
Or
UCase(strSRC) =
"FALSCH"
Then
Exit
Sub
Set
wbTRG = ThisWorkbook
Set
wbSRC = Application.Workbooks.Open(strSRC, , , 5): DoEvents
lngVorletzteZeile = wbSRC.Sheets(1).Cells(wbSRC.Sheets(1).Cells.Rows.Count, 1).
End
(xlUp).Row - 1
With
wbTRG.Sheets(1)
lngFreieZeile = .Cells(.Cells.Rows.Count, 1).
End
(xlUp).Row + 1
.Cells(lngFreieZeile, 1) = wbSRC.Sheets(1).Cells(5, 1)
.Cells(lngFreieZeile + 1, 1) = wbSRC.Sheets(1).Cells(8, 1)
.Cells(lngFreieZeile + 2, 1) = wbSRC.Sheets(1).Cells(lngVorletzteZeile, 1)
End
With
wbSRC.Close
False
Set
wbSRC =
Nothing
Set
wbTRG =
Nothing
End
Sub