alle bestanden in map openen en opslaan als waarde in cel

[gammelkeunited]

Hallo mensen,

Ik heb een map met daarin ongeveer 100 excel bestanden.
deze bestanden moeten stuk voor stuk geopend worden, en dan worden opgeslagen in een andere map onder de naam die in elk bestand op blad "Verkoop" in cel B4 staat
het originele bestand moet blijven bestaan (dus niet knippen plakken )

de map met bestanden:
H:\Machine_Overzicht_Released\Matrix

opslaan in map:
H:\Ontwikkeling\(Standaard structuur)\20 Engineering\Prijslijsten\Prijslijsten matrices

wie kan hiervoor een programma schrijven? ik heb hier zelf niet de kennis voor.
en waar moet ik het programma neerzetten? in een leeg excelbestand?

Bij voorbaat dank voor alle hulp

met vriendelijke groet,

Gammelkeunited

 

[snb]

Sub tst()
    For Each fl In CreateObject("scripting.filesystemobject").getfolder("H:\Machine_Overzicht_Released\Matrix").Files
        If Right(fl.Name, 4) = ".xls" Then
          Workbooks.Add fl.Path
          With ActiveWorkbook
            .SaveAs "H:\Ontwikkeling\(Standaard structuur)\20 Engineering\Prijslijsten\Prijslijsten matrices\" & .Sheets("Verkoop").Range("B4") & ".xls"
            .Close
          End With
        End If
    Next
End Sub

De bijlage voert deze code uit als je het bestand opent.