Automat. import multiple CSV files to multipe excel sheets in an excisting self made excel template

stefanvd12 

Freshly fished freehand from the internet .... bwefehle are in German ... should be translated if necessary.

Here is one of the many translator sites on the internet

https://www.excel-function-translation.com/index.php?page=deutsch-english.html

Sub Datei_einladen()
Dim datei As Variant
Dim Verzeichnis, GanzerName
Sheets("Auftrag 1").Select
Range("A6:A1119").ClearContents

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then Verzeichnis = .SelectedItems(1)
End With

datei = Dir(Verzeichnis & "\*.csv")
Do While datei <> ""

GanzerName = Verzeichnis & "\" & datei
Sheets("Auftrag 1").Copy after:=Sheets(Sheets.Count) 'kopiere Auftrag 1 ans Ende aller Tabellen
ActiveSheet.Name = Replace(datei, ".csv", "") 'benenne Tabelle um in Name der Datei

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & GanzerName, Destination:= _
Range("$A$6"))
.Name = "Test" & i
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 13
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Sheets("tmp").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & GanzerName, Destination:= _
Range("$A$1"))
.Name = "tmp"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Sheets(Replace(datei, ".csv", "")).Range("C3") = Sheets("tmp").Range("F3")
Sheets("tmp").Range("A1:ZZ2000").ClearContents

datei = Dir
LoopSheets("Auftrag 1").Select
Range("A6").Select
End Sub