Consolidating Data from Multiple Workbooks in Multiple Folders based on Workbook Name

AnilPullagura

Board Regular
Joined
Nov 19, 2010
Messages
98
Thanks to the Forum!!! <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
I learnt quite a bit of Excel VBA thru this forum. I have successfully created some macros to make my life easier. Thanks to forum for making this happen.<o:p></o:p>
<o:p></o:p>
Now I am stuck with another Project which I feel is beyond my caliber, hence seeking help!!!<o:p></o:p>
Project Description:<o:p></o:p>
There are 15 folders (By individual’s Name) in a Folder named “July – Entire Team”. <o:p></o:p>
Each of the 15 folders has 12 Excel workbooks which are identical. To be more specific, these 12 Workbooks denote 12 processes.<o:p></o:p>
I have another consolidation Folder name “July – Consolidated” and in this folder I have the same 12 workbooks having similar naming conventions.<o:p></o:p>
The requirement is that, <o:p></o:p>
· The macro should Open a workbook(for eg : 2117 – Exists) from “July – Consolidated” Folder<o:p></o:p>
· Then it should Open workbook with same name from each of the 15folders within “July – Entire Team” Folder,<o:p></o:p>
· Copy the data to the workbook from “July – Consolidated”<o:p></o:p>
I hope I am able to explain this a little bit. I started with a code and was stuck in between.<o:p></o:p>
Could any one of you please spare your time to look into this… Any help is greatly appreciated<o:p></o:p>
Code:
Public objFSO       As Object
    Public objFolder    As Object
    Public FileName     As Object
    Public i            As Long
    Public wkshtnames
    Public k()
Sub SubFoldersFiles(Folder)
Dim objfilename As String
objfilename = wkshtnames
    For Each SubFolder In Folder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each FileName In objFolder.Files
            If Not FileName.Name Like objfilename & "*" Then
                i = i + 1
                ReDim Preserve k(1 To i)
                k(i) = objFolder & "\" & FileName.Name
            End If
        Next
        SubFoldersFiles SubFolder
    Next
End Sub
 
Sub ListFiles()
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
    Dim StartFolder
    Dim wb          As Workbook, wbcur As Workbook
    Dim pName       As String
    Dim shName      As String
    Dim arrOutput()
    Dim opCols() As Long
    Dim ColHeads
    Dim j As Long, n As Long, c As Long, m As Long, l As Long
    Dim wksht As Worksheet
    Dim wkshtnames()
 
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        StartFolder = "C:\Users\Apullagura\Desktop\July - Team Enrollment"  'InputBox("Please enter the Folder path", "Folder Locator")
    If StartFolder = "" Then Exit Sub
 
    Set objFolder = objFSO.GetFolder(StartFolder)
        SubFoldersFiles objFSO.GetFolder(StartFolder)
    Set wbcur = Workbooks("Enrollment Consolidation Report.xls")
 
'ASSIGN WKSHTS NAMES TO ARRAY
        m = 0
    For Each wksht In ActiveWorkbook.Worksheets
        m = m + 1
        ReDim Preserve wkshtnames(1 To m)
        wkshtnames(m) = wksht.Name
    Next wksht
 
    For m = LBound(wkshtnames) To UBound(wkshtnames)
        'MsgBox wkshtnames(m)
 
        ReDim arrOutput(1 To 1000, 1 To 10)
    ColHeads = Array(Worksheets(wkshtnames(m)).Range("A1" & Range("A1").End(xlToRight).Address))
 
 
    With wbcur.Worksheets(m) '<<==adjust to suit
        On Error Resume Next
        For j = 0 To UBound(ColHeads)
            opCols(j + 1) = Cells.Find(What:=CStr(ColHeads(j)), LookAt:=xlPart).Column
        Next
    End With
 
    For i = 1 To UBound(k)
 
        Set wb = Workbooks.Open(k(i), 0)
 
        n = n + 1
 
        'DATA TRANSFERRED TO VARIABLES
        With wb.Worksheets("Sheet1")
        End With
 
        wb.Close
 
    Next
 
 
    On Error GoTo 0
    If n Then
        With wbcur.Worksheets(1)
            .Range("a2").Resize(n, 10).Value = arrOutput
        End With
    End If
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
   Next m
 
End Sub
 
Last edited:

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Forum statistics

Threads
1,224,534
Messages
6,179,391
Members
452,909
Latest member
VickiS

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top