Samle data fra alle åbne excel filer i én liste

Hvad med Konsolidering via Pivot ?

eller via en makro...

Skal de 100 rækker blot placeres efter hinanden og hvor mange kolonner er der tale om?

Jeg vil helst have det via en VBA makro, og jeg vil gerne have dem placeret efter hinanden, sådan:

Fil 1: række 1:100
Fil 2: række 101:200
etc.

Det er kolonnerne A:J fra hver fil

Ark navnet er ikke nødvendigvis det samme - men der er kun data i et ark i hver fil

Tak fordi I er så hurtige

Mvh
Ransborg

Ok - vil prøve at konstruere lidt kode til formålet.

PS: du har er række point ude!

Dem skal jeg lige få lukket af :-)

så er der bedt om svar på mine tidligere spørgsmålsoprettelser, hvor der var brugbare svar :-)

Ps. husk at give et svar

Mvh
Ransborg :-)

Kode i samlerfilen ark1:
Model med testfiler kan tilsendes - hvis der sendesen mail - @-adresse under profil.


Const hentFraSti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\Ransborg\"  'JUSTERES
Const hentFraMappeNavn = "mappeMed100"                                          'JUSTERES
Dim xlsFil As Object

Dim ræk As Long
Public Sub samlingAfRegneark()
    Application.ScreenUpdating = False
    ræk = 1
    traverserMappen hentFraSti & hentFraMappeNavn
   
    Application.ScreenUpdating = True
   
    ActiveSheet.Columns.AutoFit
   
    MsgBox ("Samlingen er udført")
End Sub
Private Sub traverserMappen(mappeNavn)
Dim fs, f, f1, fc

On Error GoTo fejl

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappeNavn)
    Set fc = f.Files
   
    For Each f1 In fc
        filnavn = f1.Name
        Set xlsFil = CreateObject("Excel.Application")
        With xlsFil
            .Workbooks.Open mappeNavn + "\" + filnavn
            .Sheets(1).Range("A1:J100").Select
            .Selection.Copy
           
            kopierTilSamling
           
            .Application.CutCopyMode = False
            .Application.Quit
        Set xlsFil = Nothing
        End With
    Next
    Exit Sub
   
fejl:
'    Stop
'    Resume Next
       
    MsgBox ("Fejl opstået: " & Err.Number & " - " & Err.Description)

    With xlsFil
        .Application.CutCopyMode = False
        .Application.Quit
    End With
    Set xlsFil = Nothing
End Sub
Private Sub kopierTilSamling()
    With ActiveSheet
        .Range("A" & CStr(ræk)).Select
        .Paste
        ræk = ræk + 100
    End With
End Sub

Meget flot løsning og løst utrolig hurtigt :-)