Forum Discussion

stefanvd12's avatar
stefanvd12
Copper Contributor
Jul 28, 2020

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

I want to import multiple CSV files in to a excisting excel template. This temlate has multiple sheets and I want to automatically import 1 CSV file in a specific tab location in sheet1. Then I want to import CSV file 2 ate the same location in sheet 2 of my workbook. So i want this to happen automatically, because now I need to load or copy/paste every single CSV file one by one in sheet 1, sheet 2, and so one. This is a time consuming problem and I want this to happen automatically. 

excel

1 Reply

  • NikolinoDE's avatar
    NikolinoDE
    Platinum Contributor
    Jul 28, 2020

    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

     

    If the solution helped you, please mark it as the correct answer so that others can also find out more. If not, please give a short feedback.

    Nikolino
    I know I don't know anything (Socrates)

Resources