So sollte es gehen, wenn ich Dich richtig verstanden habe:
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
'Im folgenden Code für wbTRG.Sheets(1) ggf. Tabellennamen einfügen, z.B. wbTRG.Sheets("Kollektion") etc
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
|