Hej Peter

Tusinde, tusinde tak for din viden og hjælpsomhed

Super med power query, virker fint. Jeg fik aldrig VBA koden til at virke, men nu kører det hele med PQ og så din "gamle" kode med 0101

Så nu spiller det hele - mange mange tak.

Rigtig god lørdag aften.

Mvh

Bjarne

Hej igen Peter

Uhmm, jeg har lavet en mappe c:\csvfiles\

I den har jeg 3 csv filer.

Skal den "nye" fil have en ny destination/ny mappe, eller?

Er lidt usikker på hvad du mener med værdien af variablen csvFolder?

På forhånd tak.

Mvh

Bjarne

uploads/2414/Report.zip

Her er de 3 filer som jeg bruger til test.

Har prøvet at ændre, men nu bliver koden ikke kørt og der kommer ikke nogen fejl. Uhmmm.

Gad vide hvad jeg gør forkert?

Public Sub ImportAllCSV()

    Dim FName As Variant, r As Long
    Dim destCell As Range
    Dim csvFolder As String
   
    csvFolder = "c:\csvfiles\"       'CHANGE THIS FOLDER PATH
    If Right(csvFolder, 1) <> "\" Then csvFolder = csvFolder & "\"
   
    With ActiveSheet
        r = .UsedRange.Row + .UsedRange.rows.Count
        Set destCell = .Cells(r, "B")
    End With
   
    FName = Dir(csvFolder & "*.csv")
    Do While FName <> ""
        r = ImportCsvFile(csvFolder & FName, destCell)
        destCell.Offset(0, -1).Resize(r, 1).Value = FName
        Set destCell = destCell.Offset(r, 0)
        FName = Dir
    Loop
   
End Sub


Private Function ImportCsvFile(FileName As String, Position As Range) As Long
    With Position.Parent.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=Position)
        .Name = Replace(FileName, ".csv", "")
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        ImportCsvFile = .ResultRange.rows.Count
        .Delete
    End With
End Function

Hej Peter

Tusinde, tusinde tak for din viden og hjælpsomhed

Super med power query, virker fint. Jeg fik aldrig VBA koden til at virke, men nu kører det hele med PQ og så din "gamle" kode med 0101

Så nu spiller det hele - mange mange tak.

Rigtig god lørdag aften.

Mvh

Bjarne