sanilmathews
Board Regular
- Joined
- Jun 28, 2011
- Messages
- 102
Hello,
I would require some help in changing the code that I have. The below mentioned code picks the value from a particular cells looping through multiple workbooks and populates in the master template. Wherein the master template is saved in the same path where other workbooks are saved. Can I get some help in rewriting the code using "Application. FileDialog(msoFileDialogFolderPicker)" ?
Since saving the master template within the folder where all the workbooks are saved is always not convenient.
Thank you so much in advance.
I would require some help in changing the code that I have. The below mentioned code picks the value from a particular cells looping through multiple workbooks and populates in the master template. Wherein the master template is saved in the same path where other workbooks are saved. Can I get some help in rewriting the code using "Application. FileDialog(msoFileDialogFolderPicker)" ?
Since saving the master template within the folder where all the workbooks are saved is always not convenient.
Thank you so much in advance.
VBA Code:
Sub GetData()
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO=New Scripting.FileSystemObject
Set SourceFolder=FSO.GetFolder(ThisWorkbook.Path)
r=Range("A65536").End(xlUp).Row+1
Application.ScreenUpdating=False
For Each FileItem In SourceFolder.Files
If FileItem.Name <> ThisWorbook.Name Then
On Error GoTo Errorhandler
Workbooks.Open (ThisWorkbook.Path & Application.PathSeparator & FileItem.Name)
ThisWorkbook.ActiveSheet.Cells(r, 1) = FileItem.Name
ThisWorkbook.ActiveSheet.Cells(r, 2) = Workbooks (FileItem.Name).Sheets(1).Range("A3").Value
ThisWorkbook.ActiveSheet.Cells(r, 3) = Workbooks (FileItem.Name).Sheets(1).Range("A4").Value
Workbooks(FileItem.Name).Close
r=r+1
End If
Next FileItem
Application.ScreenUpdating = True
Columns ("A:B").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Errorhandler: Exit Sub
End Sub