Hallo Jaffi,
wenn das Trennzeichen TABs sind, dann sollte folgende Anpasung für die Split-Zeile funktionieren.
Sub TextDateiEinlesen()
Dim varTextDatei, FF As Integer
Dim strText As String, arrData, intNumbers As Long, Spalte As Long, Spalten As Long
Dim wks As Worksheet, Zeile As Long, strPfadAkt As String
Const Spalte1 As Long = 1 'Spalte ab der Werte eingetragen werden sollen
Const Zeile1 As Long = 4 'Zeile ab der Werte eingetragen werden sollen
strPfadAkt = VBA.CurDir 'Aktives Verzeichnis merken
VBA.ChDir "C:\Lokale Daten\Test" 'Verzeichnis mit Textdateien
varTextDatei = Application.GetOpenFilename(filefilter:="Text(*.txt),*.txt", _
Title:="Bitte Textdatei mit Daten auswählen und öffnen")
If varTextDatei False Then
Set wks = ActiveSheet 'oder auch Worksheets("Tabelle1") 'Zieltabelle
FF = FreeFile()
Zeile = Zeile1 - 1 'Zeile nach der die Werte eingetragen werden sollen
Open varTextDatei For Input As #FF
Do Until EOF(FF)
Line Input #FF, strText
'Textzeile am "Tab" splitten in ein Array
arrData = Split(strText, vbTab)
'Arrayinhalte in Schritten in Zeilen eintragen
Spalte = Spalte1 'Spalte ab der Werte eingetragen werden sollen
Spalten = UBound(arrData) - LBound(arrData) + 1
Zeile = Zeile + 1
For intNumbers = LBound(arrData) To UBound(arrData)
If intNumbers > 4 Then
wks.Cells(Zeile, Spalte) = Replace(arrData(intNumbers), ",", ".")
Else
wks.Cells(Zeile, Spalte) = arrData(intNumbers)
End If
Spalte = Spalte + 1
Next
Loop
Close #FF
With wks
.Range(.Columns(Spalte1), .Columns(Spalte1 + Spalten - 1)).EntireColumn.AutoFit
With .Range(.Cells(Zeile1, Spalte1), .Cells(Zeile, Spalte1 + Spalten - 1))
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End With
End If
VBA.ChDir strPfadAkt 'aktives Verzeichnis zurücksetzen
End Sub
Aber es gibt wahrscheinlich Problemem mit den Dezimalzahlen.
ggf. muss man einen anderen Weg gehen, indem man das Textfile zunächst in einer separaten Mappe öffnet und dann die Daten in die Zieltabelle kopiert.
Sub TextDateiEinlesen_Var01()
Dim varTextDatei, wksQuelle As Worksheet, wbText As Workbook
Dim wks As Worksheet, Zeile As Long, strPfadAkt As String
Const Spalte1 As Long = 1 'Spalte ab der Werte eingetragen werden sollen
Const Zeile1 As Long = 4 'Zeile ab der Werte eingetragen werden sollen
strPfadAkt = VBA.CurDir 'Aktives Verzeichnis merken
VBA.ChDir "C:\Lokale Daten\Test" 'Verzeichnis mit Textdateien
varTextDatei = Application.GetOpenFilename(filefilter:="Text(*.txt),*.txt", _
Title:="Bitte Textdatei mit Daten auswählen und öffnen")
If varTextDatei False Then
Set wks = ActiveSheet 'oder auch Worksheets("Tabelle1") 'Zieltabelle
'Textdatei öffnen
Application.Workbooks.OpenText Filename:=varTextDatei, _
DataType:=xlDelimited, Fieldinfo:=Array(Array(1, 1), Array(1, 2), Array(1, 2), Array(1, 1) _
, _
Array(1, 1)), Tab:=True, semicolon:=False, Comma:=False, Space:=False, _
Other:=False, DecimalSeparator:=","
'Quellobjekte setzen
Set wbText = ActiveWorkbook
Set wksQuelle = ActiveSheet
'Daten kopieren
wksQuelle.UsedRange.Copy Destination:=wks.Cells(Zeile1, Spalte1)
'Zellen formatieren
With wks
With .Range(.Cells(Zeile1, Spalte1), _
.Cells(Zeile1 + wksQuelle.UsedRange.Rows.Count - 1, Spalte1 + _
wksQuelle.UsedRange.Columns.Count - 1))
.EntireColumn.AutoFit
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End With
'textdatei ohne Speichern schließen
wbText.Close savechanges:=False
End If
VBA.ChDir strPfadAkt 'aktives Verzeichnis zurücksetzen
End Sub
gruß
Franz