Sub CSVimport()
Dim pfad As Variant
Dim Dateiname As Variant
Dim DateinameKurz As Variant
Dim WS As Worksheet
pfad = Application.GetOpenFilename( _
Filefilter:="CSV Dateien (*.csv),*.csv", _
Title:="Wählen Sie eine oder mehrere Dateien aus", _
MultiSelect:=False)
Dateiname = Dir(pfad)
DateinameKurz = Left(Dateiname, Len(Dateiname) - 4)
If pfad = False Then Exit Sub
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & pfad, Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = DateinameKurz
End Sub