Merge flere excel filer i et dokument

prøv evt. denne kode (fundet på nettet)

Sub Example1_More_Sheets()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim rnum As Long
    Dim SourceRcount As Long
    Dim FNames As String
    Dim MyPath As String
    Dim SaveDriveDir As String
    Dim sh As Worksheet

    SaveDriveDir = CurDir
    MyPath = "C:\" '  Indtast aktuel sti
    ChDrive MyPath
    ChDir MyPath

    FNames = Dir("*.xls")
    If Len(FNames) = 0 Then
        MsgBox "No files in the Directory"
        ChDrive SaveDriveDir
        ChDir SaveDriveDir
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set basebook = ThisWorkbook
    basebook.Worksheets(1).Cells.Clear
    'clear all cells on the first sheet
    rnum = 1

    Do While FNames <> ""
        Set mybook = Workbooks.Open(FNames)
        For Each sh In mybook.Worksheets
            Set sourceRange = sh.Range("A1:P40")
            SourceRcount = sourceRange.Rows.Count
            Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

            basebook.Worksheets(1).Cells(rnum, "L").Value = mybook.Name & " " & sh.Name

            sourceRange.Copy destrange

            rnum = rnum + SourceRcount
        Next sh

        mybook.Close False
        FNames = Dir()
    Loop

    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Application.ScreenUpdating = True
End Sub

ret sti, og evt. Range

Beklager mit sene svar.
Jeg prøver, tak.

Rangen giver lidt problemer. Har svært ved at definere hvor langt ned i dokumentet den skal gå. Svaret er til der ikke er flere data at indlæse...

Set sourceRange = sh.Range("A1:P40")

I enkelte tilfælde er dokumentet til indlæsning tomt.
jeg må kigge videre på det ved lejlighed. Hvis der er nogen der ved hvordan man udvider ragen til at være en dynamisk værdi lig antallet af rækker med data i et givent dokument?

prøv med :

Set sourceRange = sh.UsedRange

Perfekt!

Det endelige script ser ud som følger.

------------------------------
Sub Example1_More_Sheets()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim rnum As Long
    Dim SourceRcount As Long
    Dim FNames As String
    Dim MyPath As String
    Dim SaveDriveDir As String
    Dim sh As Worksheet

    SaveDriveDir = CurDir
    MyPath = "X:\MAPPE\MED\EXCEL\FILER\" '  Indtast aktuel sti
    ChDrive MyPath
    ChDir MyPath

    FNames = Dir("*.xls")
    If Len(FNames) = 0 Then
        MsgBox "No files in the Directory"
        ChDrive SaveDriveDir
        ChDir SaveDriveDir
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set basebook = ThisWorkbook
    basebook.Worksheets(1).Cells.Clear
    'clear all cells on the first sheet
    rnum = 1

    Do While FNames <> ""
        Set mybook = Workbooks.Open(FNames)
        For Each sh In mybook.Worksheets
            Set sourceRange = sh.UsedRange
            SourceRcount = sourceRange.Rows.Count
            Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

            basebook.Worksheets(1).Cells(rnum, "L").Value = mybook.Name & " " & sh.Name

            sourceRange.Copy destrange

            rnum = rnum + SourceRcount
        Next sh

        mybook.Close False
        FNames = Dir()
    Loop

    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Application.ScreenUpdating = True
End Sub

------

Smid et svar, så du kan få point.
Jeg vil forsøge at udvide med en 'gennemse'/'browse' option, så man nemt kan angive hvilken mappe der skal anvendes. Smider scriptet her, så snart jeg har noget der virker.
Tusind tak.

ok velbekom :-)