AnilPullagura
Board Regular
- Joined
- Nov 19, 2010
- Messages
- 98
Thanks to the Forum!!! <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
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></o>
<o></o>
Now I am stuck with another Project which I feel is beyond my caliber, hence seeking help!!!<o></o>
Project Description:<o></o>
There are 15 folders (By individual’s Name) in a Folder named “July – Entire Team”. <o></o>
Each of the 15 folders has 12 Excel workbooks which are identical. To be more specific, these 12 Workbooks denote 12 processes.<o></o>
I have another consolidation Folder name “July – Consolidated” and in this folder I have the same 12 workbooks having similar naming conventions.<o></o>
The requirement is that, <o></o>
· The macro should Open a workbook(for eg : 2117 – Exists) from “July – Consolidated” Folder<o></o>
· Then it should Open workbook with same name from each of the 15folders within “July – Entire Team” Folder,<o></o>
· Copy the data to the workbook from “July – Consolidated”<o></o>
I hope I am able to explain this a little bit. I started with a code and was stuck in between.<o></o>
Could any one of you please spare your time to look into this… Any help is greatly appreciated<o></o>
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></o>
<o></o>
Now I am stuck with another Project which I feel is beyond my caliber, hence seeking help!!!<o></o>
Project Description:<o></o>
There are 15 folders (By individual’s Name) in a Folder named “July – Entire Team”. <o></o>
Each of the 15 folders has 12 Excel workbooks which are identical. To be more specific, these 12 Workbooks denote 12 processes.<o></o>
I have another consolidation Folder name “July – Consolidated” and in this folder I have the same 12 workbooks having similar naming conventions.<o></o>
The requirement is that, <o></o>
· The macro should Open a workbook(for eg : 2117 – Exists) from “July – Consolidated” Folder<o></o>
· Then it should Open workbook with same name from each of the 15folders within “July – Entire Team” Folder,<o></o>
· Copy the data to the workbook from “July – Consolidated”<o></o>
I hope I am able to explain this a little bit. I started with a code and was stuck in between.<o></o>
Could any one of you please spare your time to look into this… Any help is greatly appreciated<o></o>
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: