Copy-paste data van meerdere workbooks van meerdere subfolders naar master workbook

Status
Niet open voor verdere reacties.
D

Djani

Gebruiker
Lid geworden
16 mrt 2016
Berichten
67
Goedemiddag allemaal,

Allereerst bedankt voor je tijd en aandacht

Ik heb op internet een code kunnen vinden waarmee de macro door 1 folder loopt en van alle beschikbare files de range kopieert van het gewenste tabblad en plakt in de master workbook.
Zie hieronder:

Code: 
Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, wb As Workbook
    Dim Rws As Long, Rng As Range
    Set wb = ThisWorkbook
    MyDir = "H:\My Documents\Djani\MPCR\Project\FY17\CEN\GER\Qashqai\"
    MyFile = Dir(MyDir & "*.xls*")    
    ChDir MyDir
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        With Worksheets("Monthly_DB")
            Rws = .Cells(Rows.Count, 1).End(xlUp).Row
            Set Rng = Range(.Cells(2, 1), .Cells(Rws, 64))
            Rng.Copy wb.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close False
        End With
        MyFile = Dir()
    Loop

End Sub

Ik zou nu graag een macro willen hebben die mij in staat stelt om automatisch data te kopieren en plakken van bestanden afkomstig van meerdere subfolders van de directory. In de afbeelding hieronder zie je 2 folders: de bovenste is de folder met daarin de master workbook en de subfolders, de onderste is een voorbeeld van de subfolders met daarin de Excel bestanden (allemaal opgeslagen in .xlsb)

Untitled v2.png

Kunnen jullie mij hiermee helpen?
Mochten jullie nog extra informatie nodig hebben, let me know

PS: ik heb eerder een dergelijke vraag geplaatst bij MrExcel -> https://www.mrexcel.com/forum/microsoft-access/1031521-macro-loops-through-all-monthly-folders.html

Ontzettend bedankt & een fijne dag

Djani
 

Bijlagen

  • Untitled.png
    Untitled.png
    52,9 KB · Weergaven: 49
Je moet er een lus aan toevoegen die middels het DIR commando de Directory structuur uitleest. Ik zet die mappen dan eerst in een matrix, omdat je ander met het daaropvolgende DIR commando in de knoei komt. Dus: vanuit de startmap eerst de submappen uitlezen (de Help geeft prima aan hoe je dat doet) en in een matrix zetten, vervolgens met een lus de mappen met de matrix uitlezen met het werk dat je al hebt gedaan.
 
Ik moet eerlijk zeggen dat ikzelf geen programmeur ben - ik begrijp de VBA taal tot op een bepaalde hoogte, maar ben zelf niet in staat om een code te schrijven.

Zou je me kunnen helpen met dit, of is de vraag te complex?
 
Ik heb een code kunnen vinden die dus door alle subfolders loopt -> source = http://software-solutions-online.com/excel-vba-find-and-list-all-files-in-a-directory-and-its-subdirectories/

Code: 
Option Explicit

Const ROW_FIRST As Integer = 5

Private Sub btnGet_Click()

Dim intResult As Integer
Dim strPath As String
Dim objFSO As Object
Dim intCountRows As Integer
Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"

intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show

If intResult <> 0 Then
 strPath = Application.FileDialog(msoFileDialogFolderPicker _
 ).SelectedItems(1)

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)

 Call GetAllFolders(strPath, objFSO, intCountRows)
End If
End Sub

Code: 
Private Function GetAllFiles(ByVal strPath As String, _
ByVal intRow As Integer, ByRef objFSO As Object) As Integer
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
i = intRow - ROW_FIRST + 1
Set objFolder = objFSO.GetFolder(strPath)
For Each objFile In objFolder.Files

 Cells(i + ROW_FIRST - 1, 1) = objFile.Name

 Cells(i + ROW_FIRST - 1, 2) = objFile.Path
 i = i + 1
Next objFile
GetAllFiles = i + ROW_FIRST - 1
End Function

Code: 
Private Sub GetAllFolders(ByVal strFolder As String, _
ByRef objFSO As Object, ByRef intRow As Integer)
Dim objFolder As Object
Dim objSubFolder As Object

Set objFolder = objFSO.GetFolder(strFolder)

For Each objSubFolder In objFolder.subfolders
 intRow = GetAllFiles(objSubFolder.Path, _
 intRow, objFSO)

 Call GetAllFolders(objSubFolder.Path, _
 objFSO, intRow)
Next objSubFolder
End Sub

Deze drie macro's volgen elkaar op en geeft mij de volgende output:

Untitled v3.png

Hoe kan ik deze combineren met de code van mijn eerste bericht zodat ik van alle files de gewenste range kopieer en plak naar de master workbook?

Many thanks!
 
Laatst bewerkt:
Goedemiddag allemaal,

Excuses voor het bumpen van een oude thread, maar is er iemand die mij hierbij kunt helpen?

In onderstaande afbeelding zie je een data flow en kun je tevens ook zien bij welke stap de macro van toegevoegde waarde zult zijn.

Data flow MPCR.PNG

Ik ben op zoek naar een VBA macro die mij in staat stelt de data te kopiëren van alle producten van een bepaald land (ong. 50/60 Excel bestanden) en vervolgens plakt in de zogenoemde "master extraction file per country"

Folder structuur = 1 fiscaal jaar -> meerdere RBU's (regional business unit) -> meerdere landen -> meerdere producten
Bijv. RBU CENTER bestaat uit Duitsland/Oostenrijk/Zwitserland

De macro moet rekening houden met de volgende requirements:
1. Macro leest directory structuur en 'loopt' door subfolders
- Directory path link = H:\My Documents\Djani\MPCR\Project\FY17\CEN\GER
2. Macro kopieert en plakt data van sheet "Monthly_DB" met range "A2:BL171" in waarden naar sheet "Consolidated data" van bestand "GER - master workbook" (bestandsnaam is anders per land uiteraard)
3. Alle excel files zijn in .xlsb opgeslagen
4. Iedere keer als de macro gerund wordt, verwijdert die alle huidige data in de master file en ‘loopt’ hij opnieuw door alle subfolders

Als er belangrijke info ontbreekt of ik ben niet duidelijk genoeg, laat het mij dan aub weten

Bij voorbaat dank,

Djani
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan