Samle data fra flere filer til en fil?

Via VBA kan det lade sig gøre automatisk - ligger filerne i samme mappe?

Ja det gør de.

Hvordan foregår det vha. VBA?

Koden er indsat i en tom fil - i Ark1, kaldes Samling.xls
I den mappe, hvor denne fil ligger er der en undermappen, kaldet "Filer" - heri ligger de mange filer.
Der kopieres fra Kolonne A - J - men dette kan rettes i koden.

Hvis det kan hjælpe - kan du evt. få mine testfiler - blot mail til: pb@supertekst.it.dk

Her er koden:

Dim xSti                                            'aktuelle sti
Const arkNr = 1                                    'ark-nr, hvorfra der skal hentes
Const startRække = 1                                'begyndelsesrække i filerne, -"-
Const fraMappeNavn = "Filer"                        'undermappe med filerne

Dim samlingRække                                    'næste række for samlingsFilen
Dim samWS As Worksheet
Sub startSamling()
Rem find aktuelle sti
    xSti = findAktuelleSti
       
Rem Samlingsfilen - indsættelse af filer begynder i række 1
    Set samWS = ActiveWorkbook.Sheets("Ark1")
    samlingRække = 1
   
Rem gennemløb af filmappen
    gennemløbAfFilMappen
   
    MsgBox ("Samlingen er afsluttet")
End Sub
Private Function findAktuelleSti()
Dim sti
    sti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        sti = sti + "\"
    End If
   
    findAktuelleSti = sti
End Function
Private Sub gennemløbAfFilMappen()
Dim fraMappe, filXLS, antalRækker, ws As Worksheet
   
    fraMappe = xSti + fraMappeNavn + "\"
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(fraMappe)
    Set fc = f.Files

Rem Åbn den enkelte fil og kopier udfyldte rækker - 10 kolonner til samlingsfilen
    For Each fil In fc
        filnavn = fil.Name
        Set filXLS = CreateObject("Excel.Application")
        With filXLS
            .Workbooks.Open fraMappe + filnavn
           
            Set ws = .ActiveWorkbook.Worksheets(arkNr)
            antalRækker = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
           
Rem marker relevante område - kopier
            ws.Range("A" + CStr(startRække) + ":J" + CStr(antalRækker)).Select
            .Selection.Copy
           
Rem indsæt i samlingsfilen
            samWS.Activate
            ActiveSheet.Cells(samlingRække, 1).Select
            With Selection
                Paste
            End With
         
Rem ophæv markering
            ws.Application.CutCopyMode = False

Rem Beregn næste række i samlings-filen
            samlingRække = samlingRække + antalRækker
           
Rem Luk objektet"
            .Application.Quit
            Set filXLS = Nothing
        End With
    Next
End Sub

Du kan evt. oprette en knap på Ark1 i samlingsfilen - der aktivere den Sub, der hedder Sub StartSamling

eller

højreklik på Ark1 i Samlingsfilen - Vis programkode - sæt markøren i den første Sub = StartSamling og tryk F5.

Hvis alle arkene er 100% ens opbygget kan du også løse det ved at lave en Pivot-tabel baseret på alle arkene ("Multiple consonlidated ranges"). Herved får du i øvrigt også muligheden for at analysere dine data på kryds og tværs. Måske du kender nogen med erfaring i pivot-tabeller. Det er ganske let, men meget svært at forklare kort. Derfor blot ment som et "hint", der måske kan hjælpe dig videre.

Jeg endte med at gøre det manuelt. Det kan være jeg kigger nærmere på forslagene når jeg får tid, så hvis i vil have point så opret et svar.

jaakko - hvis jeg vælger den løsning skal jeg så ikke ind og markere området i alle mine excelfiler alligevel?

Det får du så...