Hallo,
ist jetzt ungetestet, da ich Deine txt-Dateien/-Parameter nicht kenn, aber in diese Richtung:
Option Explicit
Sub Import()
Dim strPath As String, strFileName As String
Dim wbkTarget As Workbook
strPath = "C:\Users\xxx\Downloads\"
strFileName = Dir$(strPath & "*.txt")
Call ChDir("C:\Users\spronchenko\Downloads") 'Die formatierung mittels Macroaufzeichnung ermittelt
With Workbooks
Call .OpenText(Filename:=strFileName, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
TrailingMinusNumbers:=True)
Set wbkTarget = ActiveWorkbook
With wbkTarget.ActiveSheet
' Zeile E mit unnötigen Informationen Löschen
.Columns("E:E").Delete
' Zeile C in Währung € formatieren
.Columns("C:C").NumberFormat = "#.0,0 €"
End With
strFileName = Dir$
Call .OpenText(Filename:=strFileName, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
TrailingMinusNumbers:=True)
With ActiveWorkbook.ActiveSheet
' Zeile E mit unnötigen Informationen Löschen
.Columns("E:E").Delete
' Zeile C in Währung € formatieren
.Columns("C:C").NumberFormat = "#.0,0 €"
Call .UsedRange.Copy(Destination:=wbkTarget.ActiveSheet.Cells(1, 5))
End With
End With
Set wbkTarget = Nothing
End Sub
Gruß,
|