Hent en værdi fra en fil til en anden

Er det kun en total eller ordrenr & værdi +total?

O44 er det på Ark1 eller?

Sub HentData()

RowNr = 1
Kolonne = 1
  Dim i As Integer
  With Application.FileSearch
    .LookIn = "C:\temp\Excel test\Filer"
    .FileType = msoFileTypeExcelWorkbooks

      If .Execute > 0 Then

        For i = 1 To .FoundFiles.Count
            Filnavn = .FoundFiles(i)
            strarr = Split(Filnavn, "\")
            xlsfil = "[" & strarr(UBound(strarr)) & "]"
            Navn = ""
           
            For o = 0 To UBound(strarr) - 1
                Navn = Navn + strarr(o) & "\"
            Next o
           
            Dim Formel As String
            Formel = "='" & Navn & xlsfil & "Ark1'!O1"
                                   
            Cells(RowNr, Kolonne).Formula = Formel
            RowNr = RowNr + 1
        Next i
      End If
  End With
End Sub

Det kan være du kan bruge det her til noget :)

Der er et tilføjelses program til Excel der hedder RDB Merge.

Det kan samle oplysninger fra samme celle fra flere excel ark.

Se nedenstående link:

http://www.rondebruin.nl/merge.htm

Const drevSTi = "C:\Users\peter\Desktop\Kriegbaum\"      'JUSTERES
Rem const drevSTi = "C:\Documents and Settings\Sten\Dokumenter\Ordreseddeler"
Dim total As Double, xlsObj
Public Sub optællingsSystem()
    total = 0
    traverserMappe drevSTi
   
'    MsgBox total
    Range("A1") = total
End Sub
Private Sub traverserMappe(mappesti)
Dim fs, f, f1, fc, fNavn As String, ext As String, navnSplit As Variant

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappesti)
    Set fc = f.Files
   
    For Each f1 In fc
        If InStr(LCase(f1), "ordre.") > 0 Then
            Set xlsObj = CreateObject("Excel.Application")
            xlsObj.Workbooks.Open f1
            total = total + xlsObj.ActiveWorkbook.Sheets(1).Range("O44")
            xlsObj.Quit
            Set xlsObj = Nothing
        End If
    Next
End Sub

Supertekst.

Det ville være fint med ordre nr, værdi og total

det er i celle o44  "Ark1" hedder Ordre

Ok - vender tilbage senere..

det lyder super

Rem Version 2
Const drevSTi = "C:\Users\peter\Desktop\Kriegbaum\"      'JUSTERES
Rem const drevSTi = "C:\Documents and Settings\Sten\Dokumenter\Ordreseddeler"

Const tælOpFraFileDerIndeholder = "ordre."
Dim total As Double, xlsObj
Dim ræk As Long, ordreNr As Long, værdi As Double
Public Sub optællingsSystem()
    total = 0
    ræk = 1
   
    traverserMappe drevSTi
End Sub
Private Sub traverserMappe(mappesti)
Dim fs, f, f1, fc

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappesti)
    Set fc = f.Files
   
    For Each f1 In fc
        If InStr(LCase(f1), tælOpFraFileDerIndeholder) > 0 Then
            Set xlsObj = CreateObject("Excel.Application")
            xlsObj.Workbooks.Open f1
            værdi = xlsObj.ActiveWorkbook.Sheets(1).Range("O44")
            total = total + værdi
            ordreNr = isolerOrdreNr(f1.Name)
            xlsObj.Quit
            Set xlsObj = Nothing
           
            Range("A" & ræk) = ordreNr
            Range("B" & ræk) = værdi
            ræk = ræk + 1
        End If
    Next
   
    Range("B" & ræk) = total
End Sub
Private Function isolerOrdreNr(filNavn)
Dim p As Byte, navn As String
    navn = Mid(filNavn, 7)                      'ordrenr isoleres
    isolerOrdreNr = Left(navn, Len(navn) - 4)  '.xls fjernes
End Function

er der noget jeg skal fjerne eller lave om i den eller skal den bare sættes ind og så virker der?

Const drevSTi = "C:\Users\peter\Desktop\Kriegbaum\"      'JUSTERES
Rem const drevSTi = "C:\Documents and Settings\Sten\Dokumenter\Ordreseddeler"

Slet den øverste og fjern Rem i den næste. Sæt koden ind i en ny xls-fil under Ark1. Denne fil kan du evt. kalde system.xls.

Ellers er du velkommen til at sende en mail - så returnere jeg min model. @-adresse under min profil.

Jeg har lige sendt dig en mail

Supertekst
Mange tak for hjælpen.
det har været en stor hjælp..


IT-GuFFe
Dit foreslag virkede faktisk også men der manglede jeg ordre nr. og total beløb.

men som koden var virkede den super