Åbne filer

Public Sub HentArk()
    Dim Fil As String, Sti As String
    Sti = "\resultater" ' Ret til din sti
    Application.ScreenUpdating = False
    Fil = Dir(Sti & "\*.xls")
    Do While Fil <> ""
        Workbooks.Open Filename:= _
                      Sti & "\" & Fil
        Sheets("1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Sheets("1").Name = Fil
        Windows(Fil).Close
        Fil = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

hvis du ikke vil have .xls med i fanenavnet så ret

  Sheets("1").Name = Fil
til
  Sheets("1").Name = Split(Fil, ".")(0)

skulle være et svar ;-))

Jeg tror jeg løber ind i problemer: Der er et ark, der i forvejen hedder 1. Kan vi omdøbe det inden de kopieres?

Altså kan vi omdøbe dem vi kopier inden de kopieres? Den der hedder 1 i den projektmappe, hvor makroen køres fra skal bibeholde sit navn 1

Public Sub HentArk()
    Dim Fil As String, Sti As String
    Sti = "\data" ' Ret til din sti
    Application.ScreenUpdating = False
    Fil = Dir(Sti & "\*.xls")
    Do While Fil <> ""
        Workbooks.Open Filename:= _
                      Sti & "\" & Fil
                        Sheets("1").Name = Split(Fil, ".")(0)
        Sheets(Split(Fil, ".")(0)).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
     
        Windows(Fil).Close False
        Fil = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Fantastisk Kabbak :-)
Nu er nu er spørgsmålet så om jeg kan få dig til at gøre en enkelt ting mere:
Nu har jeg alle arkene inde i min nye projektmappe.
De er alle ens, men hedder noget forskelligt.
Kan jeg få kolonnen D i alle de ark, der er kopieret ind langt sammen i fanen Status i kolonne D startene med række 2 til række 19000?
Hvis du kan det, kan du få de point jeg har i spørgsmålhttp://www.eksperten.dk/spm/873169

pft!

Det kan du da gøre med en formel

=SUM(FørsteIndlæsteArk:SidsteIndlæsteArk!D2)

Træk den nedad til række 19000

Det er jeg godt klar over, men dem der skal bruge arket, er ikke vandt til at bruge regneark, så derfor vil jeg gerne have så meget automatiseret som muligt.

Men som du skriver, så kan din løsning godt bruges!

Er det svært at lave?

er det samtidig med at de ark der importeres, at udregningen skal laves ? og kun denne ene gang

Nu beregner den mens den indlæser

Public Sub HentArk()
    Dim Fil As String, Sti As String, Total(19000), I As Integer
    Sti = "\data" ' Ret til din sti
    Application.ScreenUpdating = False
    Fil = Dir(Sti & "\*.xls")
    Do While Fil <> ""
        Workbooks.Open Filename:= _
                      Sti & "\" & Fil
                        Sheets("1").Name = Split(Fil, ".")(0)
        Sheets(Split(Fil, ".")(0)).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
       
    For I = 0 To 19000
    Total(I) = Total(I) + Cells(I + 2, "D")
    Next
   
        Windows(Fil).Close False
        Fil = Dir
    Loop
    Sheets("Status").Range("D2:D19001") = WorksheetFunction.Transpose(Total)
    Application.ScreenUpdating = True
End Sub

Har jeg ret i at det eneste du har tilføjet er:

Sheets("Status").Range("D2:D19001") = WorksheetFunction.Transpose(Total)

i 3. sidste linje?

Den virker ikke - Den skriver et 0 i alle celler i kolonne D fra D2:D190001

også tilføjet

  For I = 0 To 19000
    Total(I) = Total(I) + Cells(I + 2, "D")
    Next

Ja, og så var der lige Total(19000), I As Integer øverst :-)

Tak for hjælpen.
Smid et svar i http://www.eksperten.dk/spm/873169

Håber også vi (du) finder en løsning i http://www.eksperten.dk/spm/874133

Tak!