Forum Discussion
Automat. import multiple CSV files to multipe excel sheets in an excisting self made excel template
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
Nikolino
I know I don't know anything (Socrates)