hent data fra flere excel filer til en samlet ark med makro

Prøv at se spm. 939911 - måske inspiration...

Hej supertekst
jeg her lige kigget på den.. men jeg er ikke en haj til vba, så den ser lidt teknisk ud.

hej igen. jeg syntes ikke den kode du henviser til finder den fil der ligger i under mappen og mine filer har mere en tal som navn..

beklager men jeg syntes ikke den hjælper mig.

Hej RonaldF

Nu er koden jo også udviklet til den specielle opgave, som jeg henviser til. Så der skal ske en hvis modifikation.

ja men jeg kan ikke rigtigt fnde ud af hvordan man gør det
Det er for kompliceret for mig :-(

Ok - hvis du opbygger en lille model med f.eks. 3 kunder - pakker det ind i den realistiske mappe-struktur - zipper det hele og sender det til mig - så skal jeg prøve at komme med et forslag. Det bliver ikke lige med det samme..

@-adresse under min profil.

Endnu engang mange tak for hjælpen
Hilsen Ronald

Const stiTilKundeMapper = "C:\Users\......"    '<--- tilpasses
Dim xlsFil As Object
Const startRæk = 12

Dim aktuelleSti As String, ræk As Long, antal As Long
Public Sub hentKundeData()
    antal = 0
    ræk = startRæk
   
    Application.ScreenUpdating = False
    traverserKundeMappen stiTilKundeMapper
    Columns.AutoFit
   
    Application.ScreenUpdating = True
   
    MsgBox "Data er hentet fra " & CStr(antal) & " kunder"
End Sub
Private Sub traverserKundeMappen(mappeSti)
Dim fs, f, f1, fc, fx, fNavn As String
Dim kundeNr, ForNavn, EfterNavn, VejNavn, postNr, ByNavn

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappeSti)
   
    Set fc = f.SubFolders
    For Each f1 In fc
        n = f1.Name
        For Each fil In f1.Files
            fNavn = fil.Name
            If InStr(fil.Name, "Stamkort") = 1 Then
                Set xlsFil = CreateObject("Excel.Application")
                With xlsFil
                    .Workbooks.Open mappeSti & "\" & f1.Name & "\" & fNavn
                    .Sheets(1).Activate
                    kundeNr = .Range("K4")
                    ForNavn = .Range("B5")
                    EfterNavn = .Range("F5")
                    VejNavn = .Range("B7")
                    postNr = .Range("F7")
                    ByNavn = .Range("G7")
                   
Rem indsæt i samleark
                    Range("A" & ræk) = kundeNr
                    Range("B" & ræk) = ForNavn
                    Range("C" & ræk) = EfterNavn
                    Range("D" & ræk) = VejNavn
                    Range("E" & ræk) = postNr
                    Range("F" & ræk) = ByNavn
                   
                    ræk = ræk + 1
                    antal = antal + 1
                    .Quit
                End With
               
                Set xlsFil = Nothing
                Exit For
            End If
        Next
    Next
End Sub

Disse ting er udført, hvordan får outlook fat i regnearket.