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"
)
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
.Columns(
"E:E"
).Delete
.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
.Columns(
"E:E"
).Delete
.Columns(
"C:C"
).NumberFormat =
"#.0,0 €"
Call
.UsedRange.Copy(Destination:=wbkTarget.ActiveSheet.Cells(1, 5))
End
With
End
With
Set
wbkTarget =
Nothing
End
Sub