Kæder til 52 ark = 52 spg. når man starter

Hvis alle dine filer ligger i samme mappe beskriver spørgsmål http://www.eksperten.dk/spm/333245 hvordan du kan overføre dine 40 kæder til et hovedark.

Hej jan

hvor fortæller jeg markroen at at den skal hente 40 celler fra eks. uge 1.xls og overføre dem til min fil med resultater

I spørgsmålet er der vist et eksempel med 3 celler C3, C24 og D24.
Du kan så udvide makroen med dine egne 40 links.

OK ... prøver mig lige frem

Det er måske ikke den løsning der søges i spørgsmålet, men kunne man ikke bare fjerne hakket i: "Spørg, om kæder skal opdaters automatisk" i -> Funktioner -> Indstillinger -> Rediger.

Jeg kan ikke rigtig hitte ud af det :(

Hvor i markoen fortæller jeg den hvor den skal hente fra (eks [uge 1.xls]B1 + B2 +osv.)
og
Hvor fortæller jeg den hvor den skal indsætte det

chewie

jeg går ud fra dette er hvor den henter
-------------------------------------------
For i = 1 To wbCount
        r = r + 1
        C3Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark1", "C3")
        C24Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark1", "C24")
        D24Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark1", "D24")
        Cells(r, 1).Formula = wbList(i)
        Cells(r, 2).Formula = C3Value
        Cells(r, 3).Formula = C24Value
        Cells(r, 4).Formula = D24Value
    Next i
--------------------------------------------

s_h_m >> eller tak :o) """"om jeg vil opdatere (det vil jeg gerne) """

OK ... toro nu jeg er fattet lidt afligevel .... den laver en liste :o)

mit problem er nu at jeg ikke for nogle liste .... nogle der kan se hvor jeg har overset noget .... måske

____________________________________________________
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
    FolderName = "F:\MSE\AMP\Tidsregistrering\Gemte tidsregistreringer\"
    ' create list of workbooks in foldername
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    ' get values from each workbook
    r = 0
    Workbooks.Add
    For i = 1 To wbCount
        r = r + 1
        H4Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ialt for ugen", "H4")
        H5Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H5")
        H6Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H6")
        H7Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H7")
        H8Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H8")
        H9Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H9")
        H10Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H10")
        H11Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H11")
        H12Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H12")
        H13Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H13")
        H14Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H14")
        H15Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H15")
        H16Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H16")
        H17Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H17")
        H18Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H18")
        H19Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H19")
        H20Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H20")
        H21Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H21")
        H22Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H22")
        H23Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H23")
        H24Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H24")
        H25Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H25")
        H26Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H26")
        H27Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H27")
        H28Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H28")
        H29Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H29")
        H30Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H30")
        H31Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H31")
        H32Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H32")
        H33Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H33")
        H34Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H34")
        H35Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H35")
        H36Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H36")
        H37Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H37")
        H38Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H38")
        H39Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H39")
        H40Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H40")
        H41Value = GetInfoFromClosedFile(FolderName, wbList(i), "Ark17", "H41")
        Cells(r, 1).Formula = wbList(i)
        Cells(r, 2).Formula = H4Value
        Cells(r, 3).Formula = H5Value
        Cells(r, 4).Formula = H6Value
        Cells(r, 5).Formula = H7Value
        Cells(r, 6).Formula = H8Value
        Cells(r, 7).Formula = H9Value
        Cells(r, 8).Formula = H10Value
        Cells(r, 9).Formula = H11Value
        Cells(r, 10).Formula = H12Value
        Cells(r, 11).Formula = H13Value
        Cells(r, 12).Formula = H14Value
        Cells(r, 13).Formula = H15Value
        Cells(r, 14).Formula = H16Value
        Cells(r, 15).Formula = H17Value
        Cells(r, 16).Formula = H18Value
        Cells(r, 17).Formula = H19Value
        Cells(r, 18).Formula = H20Value
        Cells(r, 19).Formula = H21Value
        Cells(r, 20).Formula = H22Value
        Cells(r, 21).Formula = H23Value
        Cells(r, 22).Formula = H24Value
        Cells(r, 23).Formula = H25Value
        Cells(r, 24).Formula = H26Value
        Cells(r, 25).Formula = H27Value
        Cells(r, 26).Formula = H28Value
        Cells(r, 27).Formula = H29Value
        Cells(r, 28).Formula = H30Value
        Cells(r, 29).Formula = H31Value
        Cells(r, 30).Formula = H32Value
        Cells(r, 31).Formula = H33Value
        Cells(r, 32).Formula = H34Value
        Cells(r, 33).Formula = H35Value
        Cells(r, 34).Formula = H36Value
        Cells(r, 35).Formula = H37Value
        Cells(r, 36).Formula = H38Value
        Cells(r, 37).Formula = H39Value
        Cells(r, 38).Formula = H40Value
        Cells(r, 39).Formula = H41Value

    Next i

End Sub
_____________________________________________________________

Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
______________________________________________________________

Ligger der nogle filer i mappen: F:\MSE\AMP\Tidsregistrering\Gemte tidsregistreringer\?

Indeholder disse filer fanerne: "Ark17" og "Ialt for ugen"?

Ja der ligger 3 filer (uge 18.xls - uge 19.xls og uge 20.xls)

Det ark der skal hentes fra er "Ialt for ugen" (det hedder også ark17 i VBA)

F:\MSE\AMP\Tidsregistrering\Gemte tidsregistreringer\?

den kommer og siger "kompileringsfejl:" på denne sætning

Jeg sad lige og kiggede på den her. Der er vel ikke sådan at du mangler at skrive Sub Etnavn() i starten.

Jeg har forkortet din makro lidt. Prøv lige at teste, for den kører fint her.


Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
Dim rngHent As Range
Dim strTemp As String
Dim x As Long
Dim c As Range
Set rngHent = Range("F1:F41")
    FolderName = "F:\MSE\AMP\Tidsregistrering\Gemte tidsregistreringer"
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    r = 0
    For i = 1 To wbCount
        r = r + 1
        Cells(r, 1).Formula = wbList(i)
        x = 1
        For Each c In rngHent
            x = x + 1
            strTemp = c.Address
            cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Ialt for ugen", strTemp)
            Cells(r, x).Formula = cValue
        Next
       
    Next i
End Sub

Ups, du skal lige ændre Set rngHent = Range("F1:F41")  til
Set rngHent = Range("H4:H41")

Ja det var nok Sub ReadDataFromAllWorkbooksInFolder() der manglede :o)

men alle mine resultater viser #REFERENCE ... bortset fra filnavn(A1)

det er bak´s version jeg afprøver nu !!

Ja, det kan være  fordi du bruger vba-navnet Ark17, brug det rigtige navn "Ialt for ugen"

Ja, det kunne godt se ud som om der mangler en
Sub ReadDataFromAllWorkbooksInFolder() eller lign. i starten.

Hov, sorry, men min version er i praksis fuldstændig magen til Jans. (kopieret :-)), så du skal stadig have denne funktion liggende

Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

Ups, der var sket lidt i mellemtiden .... :-)

Husk at du også skal have Function GetInfoFromClosedFile med.

.... og så var der sket lidt igen :-)

Den har jeg ikke rørt ved ! .... kan det være fordi at de celler jeg henter fra (uge1.xls, uge2.xls,osv.) ser sådanne ud

=SUM(BHU!H4;BLN!H4;BPE!H4;BRC!H4;CBI!H4;CHO!H4;CHR!H4;JRP!H4;KWJ!H4;MNO!H4;NNI!H4;PEA!H4;RIH!H4;TBJ!H4;TIV!H4)

Det tror jeg ikke.
jeg tror nærmere at det er fordi du har en fejlskrivning i arknavnet.
Altså at arknavnet ikke findes :-)

Jeg prøvede at ændre alle stierne og ændre dem tilbage igen ... så jeg er sikker på der er rigtige !!

Og nu virker det :o)

Mange Mange tak for hjælpen

bak >> smid et svar ... så får du lidt points for din deltagelse ...TAK

Tak for det :-)

Jeg prøver lige igen    ..........

En lille tilføjelse. Hvis det er data der skal analyseres er det af og til rart at kunne dobbeltklikke på cellen med data og så popper det rigtige ark op.
For at gøre det skal man have rigtige links til regnearkene.
og man skal under funktioner/indstillger fjerne fluebenet i direkte redigering i celler

Hvis du erstatter Function GetInfoFromClosedFile med denne her laver den links istedet, vel og mærke kun til ark der eksisterer :-)

Function GetInfoFromClosedFile(p, f, s, c)
If Right(p, 1) <> "\" Then p = p & "\"
GetInfoFromClosedFile = "='" & p & "[" & f & "]" & s & "'!" & Range(c).Address(, , xlA1)
End Function

Det lyder smart .... men i mit tilfælle er der ikke brug for det

men ... jeg har et andet lille problem

Hvis jeg ikke ønsker resultatet indsat i A1 på det aktive ark ... hvordan ændre jeg så det ?? (til eks. B6 på ark "database")

/chewie

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
Dim rngHent As Range
Dim strTemp As String
Dim rngStart As Range
Dim x As Long
Dim c As Range

    Set rngStart = ActiveWorkbook.Sheets("Database").Range("B6")
    Set rngHent = Range("H4:H41")
    FolderName = "F:\MSE\AMP\Tidsregistrering\Gemte tidsregistreringer"
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
   
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    r = 0
    For i = 1 To wbCount
        r = r + 1
        rngStart(r, 1).Formula = wbList(i)
        x = 1
        For Each c In rngHent
            x = x + 1
            strTemp = c.Address
            cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Ialt for ugen", strTemp)
            rngStart(r, x).Formula = cValue
        Next
       
    Next i
End Sub

Meget smukt :o)

Tak