Alle filer i en mappe

Dim strFilNavn(300), Nr As Integer
mypath = "C:\data\" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
  Nr = Nr + 1
End If
strFilNavn(Nr) = Dir    ' Hent næste filnavn.
Loop

Det virker fint kabbak. Men jeg har lige udvidet din kode med dette, og så opstår der en 'Subscript out of range' fejl:

Sub forsøg()

Dim strFilNavn(300), Nr As Integer
mypath = "C:\dokumenter\" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
  Cells(1, Nr) = strFilNavn(Nr)
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
    Nr = Nr + 1
  End If
  strFilNavn(Nr) = Dir    ' Hent næste filnavn.
  Cells(Nr, 1) = strFilNavn(Nr)
  Cells(Nr, 4) = Workbooks(strFilNavn(Nr)).Worksheets("Ark1").Range("A1")
 
Loop

End Sub

Hvad er der galt? Det er ikke fordi, at Ark1 ikke findes i filerne!

hvad vil du med denne linie.

Cells(Nr, 4) = Workbooks(strFilNavn(Nr)).Worksheets("Ark1").Range("A1")

Sub forsøg()
Dim strFilNavn(300), Nr As Integer
mypath = "C:\dokumenter\" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
  Cells(1, Nr) = strFilNavn(Nr)
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
  Cells(Nr, 1) = strFilNavn(Nr)
  'Cells(Nr, 4) = Workbooks(strFilNavn(Nr)).Worksheets("Ark1").Range("A1")
    Nr = Nr + 1
  End If
  strFilNavn(Nr) = Dir    ' Hent næste filnavn.
Loop
End Sub

har rykket dine 2 linier op, de skal stå før,
  Nr = Nr + 1

Jeg ville blot teste det af, inden jeg går i gang med det, som jeg i virkeligheden påtænker at lave.

Jeg undgår ikke fejlen ved at flytte linjen op i IF strukturen. Gør du?

jeg får fejl i denne linie, men jeg kan ikke se hvad du vil have den til at gøre.

Cells(Nr, 4) = Workbooks(strFilNavn(Nr)).Worksheets("Ark1").Range("A1")

En anden ting er at hvis der er mere end 300 filer i dit bibliotek skal denne linie ændres.
Dim strFilNavn(300), Nr As Integer

er det dette du vil, vise både sti og mappe.

  Cells(Nr, 4) = mypath & strFilNavn(Nr)

Sub forsøg()
Dim strFilNavn(300), Nr As Integer
mypath = "C:\Documents and Settings\hba\Data\Div excel" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
  Cells(Nr, 1) = strFilNavn(Nr)
Cells(Nr, 4).Select
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        mypath & strFilNavn(Nr)
      ' skriver hyperlink på alle mapper I D kolonnen
      Nr = Nr + 1
  End If
  strFilNavn(Nr) = Dir    ' Hent næste filnavn.
Loop
End Sub

ny udgave med hyperlink i D kolonne

He he - "IMperten" - du må være ingeniør ;o)

Jeg er ikke ingeniør! Eksport er salg af varer til udlandet, import er modtagelse af varer fra udlandet. En ekspert er en person, der giver viden fra sig. En impert er en person, som tager viden til sig.

Nu virker det kabbak; men den skriver jo blot stien i kolonne 4. Jeg ønsker, at få indholdet i celle A1 i de forskellige regneark vist. Meningen er, at jeg på længere sigt skal konstruere en makro, som kan gå ind og læse en mængde oplysninger i andre regneark, placeret i diverse undermapper.

Ok - troede det var et humoristisk selvopfundet ord - har aldrig hørt det før :o)

Her henter den værdien fra Ark1 A1 ind i D kolonnen.

det er som formel så den ændres hvis der sker ændringer i mappen.

Sub forsøg()
Dim strFilNavn(300), Nr As Integer
mypath = "C:\dokumenter\" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
  Cells(Nr, 1) = mypath & strFilNavn(Nr)
Cells(Nr, 4).Select
  ActiveCell.Formula = "='" & mypath & "[" & strFilNavn(Nr) & "]Ark1'!R1C1"
  Nr = Nr + 1
  End If
  strFilNavn(Nr) = Dir    ' Hent næste filnavn.
Loop

End Sub

denne skriver værdien, så ingen kæder.

Sub forsøg()
Dim strFilNavn(300), Nr As Integer, A as Variant
Application.ScreenUpdating = False
mypath = "E:\Dokumenter\Excel\" ' ret til din sti
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
Nr = 1
strFilNavn(Nr) = Dir(mypath & "*.xls")  ' Hent den første filnavn.
Do While strFilNavn(Nr) <> ""  ' Start løkken
  If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then
  Cells(Nr, 1) = strFilNavn(Nr)
  Workbooks.Open Filename:=mypath & strFilNavn(Nr)
  Sheets("Ark1").Select ' ADVARSEL du får fejl hvis arket ikke eksisterer
  A = Range("A1").Value
  Windows(strFilNavn(Nr)).Activate
    ActiveWindow.Close
      Windows("data.xls").Activate' mappen med koden i
      Cells(Nr, 4) = A
  Nr = Nr + 1
  End If
  strFilNavn(Nr) = Dir    ' Hent næste filnavn.
Loop
Application.ScreenUpdating = True
End Sub

Så var den der. Så må du hellere få dine velfortjente points!