Hente celle data fra andre projekt mapper

Er er et lille eks. hvor der i:
celle A1 står fulde stinavn (f.eks P:\TEST\)
celle B1 står regnearknavn (f.eks TEST.XLS)
celle C1 står arknavn (f.eks Ark1)
celle D1 står cellenavn (f.eks F99)

Eks. åbner det angivet regneark, kopiere fra et bestem ark, fra en bestem celle og ligger det i samme celle i modtager arket. (Kopi af celle F99 fra TEST.XLS ender i celle F99 i modtager arket). Dette er ændres ved, at også have en modtager celle.

Sub Find()
    Dim strStinavn As String
    Dim strFilnavn As String
    Dim strFeltnavn As String
    Dim strArknavn As String
   
    strStinavn = Range("A1")
    strFilnavn = Range("B1")
    strArknavn = Range("C1")
    strFeltnavn = Range("D1")
   
    Workbooks.Open Filename:=strStinavn + strFilnavn
    Sheets(strArknavn).Select
    Range(strFeltnavn).Select
    Selection.Copy
    Windows("mappe1").Activate
    Range(strFeltnavn).Select
    ActiveSheet.Paste
    Windows(strFilnavn).Activate
    ActiveWorkbook.Close savechanges:=False
   
End Sub

Hej
Denne mackro henter data fra celle B1 i alle faner fra alle regneark i udvalgt katalger.
Du skal copiere denne mackro over i et nye regneark, som dog ikke må gemmes i kataloget med dine "data".
PÅ Ark2 i Celle A1 skriver du dit katalog ( eks c:\test1\ ), i celle A2 det næste katalog  osv.
Dine data indlæses ind på Ark1


Sub HentData()
Dim Linje As Integer, Katalog As Integer, ArkNo As Integer
Dim NyPath As String, myName As String
Linje = 1
Katalog = 1

On Error GoTo Fejl
Application.ScreenUpdating = False

'NyPath = "c:\"
Do While ThisWorkbook.Sheets("Ark2").Cells(Katalog, 1).Value <> ""  '
NyPath = ThisWorkbook.Sheets("Ark2").Cells(Katalog, 1).Value

myName = Dir(NyPath & "*.xls")

Do While myName <> ""
    If myName <> "." And myName <> ".." Then
    Workbooks.Open Filename:=NyPath & myName, ReadOnly:=True
   
    For ArkNo = 1 To ActiveWorkbook.Sheets.Count
    ThisWorkbook.Sheets("Ark1").Cells(Linje, 1).Value = myName
    ThisWorkbook.Sheets("Ark1").Cells(Linje, 2).Value = ActiveWorkbook.Sheets(ArkNo).Name
    ThisWorkbook.Sheets("Ark1").Cells(Linje, 3).Value = ActiveWorkbook.Sheets(ArkNo).Range("B1")
    Linje = Linje + 1
    Next ArkNo
   
    Workbooks(myName).Close
   
      End If
    myName = Dir    ' Get next file
 
Loop
Katalog = Katalog + 1
Loop

    Application.ScreenUpdating = True
    Exit Sub
   
Fejl:
Application.ScreenUpdating = False

End Sub

Tak for svaret oleelo.

Jeg kan bare ikke få den til at køre jeg har rettet celle navn til. men hvad er der ellers jeg skal rette til. Hva med (NyPath="c:\") hvad hen viser den til?

Nu virker det mange tak.  det eneste kan man måske på den til at adskille listen på ark 1 med en linie med navn på mappen?

og måsks kun hente fra ark 1?

Hej
'NyPath="c:\" er noget kode er ikke bruge , bemærk ' (flugeben ) først i linjen hvilket betyder at det ikke er kode.

Hvis du vilhave en tom linjen sætter du : Linje = Linje + 1 til :Linje = Linje + 2

Hvis du kun vil have ark1 Ændre du : For ArkNo = 1 To ActiveWorkbook.Sheets.Count  til : ArkNo = 1    og sletter : Next ArkNo

ArkNo er index nr for arket , Sheets(ArkNo) kan også rettes til eks Sheets("Ark1") . Navnene retter du til så det passer med hvad du har

mvh oleelo