Importere data fra flere filer i en mappe

Ja - men har ikke tid lige nu...

Til første spørgsmål.

Du kan starte med at lave en løkke der kigger i mappen via kommandoen DIR. Derefter laver du en løkke der angiver hvert navn i din importfunktion.

Det kan anbefales at importere i en liste (array), som er langt hurtigere og du kan nemmere overskue hvor meget du har importeret.

Hej Gnowak

tak for tipppet.
Mit problem er bare at jeg ikke kan finde ud af at lave løkker og indlæse i en array :-)

Når jeg ser koder fra jer experter kan jeg som regel finde ud af at lave mindre rettelser selv, men jeg kan under ingen omstændigheder finde ud af at bygge en kode som denne op fra bunden, desværre.

REM Sub "ImporterEnFil" skal tilpasses iflg. din spec.

Const importMappeNavn = "C:\Import\"
Const erImporteretMappeNavn = "C:\ErImporteret\"

Public Sub importer()
Dim fs, f, f1, fc
Dim filSti As String, filNavn As String, indsætIcelle As String, ræk As Long

Rem traverser import-mappen
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(importMappeNavn)
    Set fc = f.Files
   
    For Each f1 In fc
        filNavn = f1.Name
        filSti = f1.Path
        ræk = Range("A65536").End(xlUp).Row
        If ræk > 1 Then
            ræk = ræk + 1
        End If
       
        indsætIcelle = "$A$" & CStr(ræk)
       
        importerEnFil filSti, filNavn, indsætIcelle
    Next
   
    flytImporteredeFiler
   
    MsgBox "Import er udført"
End Sub
Private Sub importerEnFil(filSti, filNavn, indsætIcelle)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filSti _
        , destination:=Range(indsætIcelle))
        .Name = filNavn
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .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, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Private Sub flytImporteredeFiler()
Dim fs, f, f1, fc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(importMappeNavn)
    Set fc = f.Files
   
    For Each f1 In fc
        FileCopy importMappeNavn & f1.Name, erImporteretMappeNavn & f1.Name
        Kill importMappeNavn & f1.Name
    Next
End Sub

Var det en løsning???

Så fik endelig tid til at sætte mig ned og teste på det.
Det virker fuldstændig som det skal.

Beklager den lange svartid, men jeg har været arbejdet alt alt for meget i den sidste tid :-(

Mange tak for hjælpen.

Ok & Selv tak..