Retrieve data from multiple workbooks, all in the same selected folder? - excel

Question

I want to retrieve data from multiple Excel workbooks in a folder.
The files are not opened.
The workbooks are called: Business Case (1), Business Case (2)... (incrementally growing until ~50).
I need the data to do business analysis, and evaluate potential ideas.
I got it working until file nr. 11 with the "Indirect" function. It won't retrieve more data after 10+; so I started looking at VBA.
The first problem I ran into with VBA, is that lopping through Excel files, looks like it requires a "fixed" path (e.g.: c:\Users\Bonkers\Desktop\Folder.....). I want the master-data-retrieval-book to work on other PCs, so the path of the folder, needs to be "not limited" to my PC.
Function ChooseFolder(strTitle As String, fDtype) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(fDtype)
With fldr
.Title = strTitle
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Sub datatransfer()
Dim FolderPath As String
Dim FilePath As String
Dim Filename As String
Dim targetfile As String
Dim wb1 As Workbook, wb2 As Workbook
targetfile = ChooseFolder("Please select the target file", msoFileDialogFilePicker)
FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
FilePath = FolderPath & "\Business Case (*.xls*)"
Set wb2 = Workbooks.Open(targetfile) 'only need to open this once and leave open until execution is finished
Filename = Dir(FilePath)
Do While Filename <> "" ' need "<>" to say not equal to nothing
wb2.Worksheets.Add After:=wb2.Worksheets(wb2.Worksheets.Count) 'add new sheet to paste data in target book
Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)
Dim lastrow As Long, lastcolumn As Long
With wb1.Worksheets(1) 'best to qualify all objects and work directly with them
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
'pretty sure you want to add this A1, since it's a new blank sheet
.Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy _
Destination:=wb2.Worksheets(wb2.Worksheets.Count).Range("A1")
End With
wb1.Close False 'assume no need to save changes to workbook you copied data from
Filename = Dir
Loop
wb2.Close True 'no close and save master file
End Sub

Answer 1

If you need to dynamically set the files folder and the target file you can use the next adapted function:
Function ChooseFolder(strTitle As String, fDtype) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(fDtype)
With fldr
.Title = strTitle
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Then, in the processing Sub you may call it in the next way:
targetfile = ChooseFolder("Please select the target file", msoFileDialogFilePicker)
FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
FilePath = folderPath & "\Business Case (*.xls*"
Edited:
Please, use this updated code. It will copy all the range as it is. Since, I do not know if the content of the all involved workbooks looks the same, I tried designing the code to behave as for the similar structures:
Sub datatransfer()
Dim FolderPath As String, FilePath As String, Filename As String, targetfile As String
Dim wb1 As Workbook, wb2 As Workbook, astrow As Long, lastcolumn As Long
FolderPath = ChooseFolder("Please select the Folder path", msoFileDialogFolderPicker)
targetfile = ChooseFolder("Please select the target file", msoFileDialogFilePicker)
FilePath = FolderPath & "\Business Case (*.xls*" 'you wrongly copied this line...
Set wb2 = Workbooks.Open(targetfile)
Filename = Dir(FilePath)
Do While Filename <> ""
wb2.Worksheets.Add After:=wb2.Worksheets(wb2.Worksheets.Count) 'add new sheet to paste data in target book
Set wb1 = Workbooks.Open(FolderPath & "\" & Filename)
With wb1.Worksheets(1) 'best to qualify all objects and work directly with them
lastrow = .UsedRange.Rows.Count + .UsedRange.Row
lastcolumn = .UsedRange.Columns.Count + .UsedRange.Column
.Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy _
Destination:=wb2.Worksheets(wb2.Worksheets.Count).Range("A2")
End With
wb1.Close False 'assume no need to save changes to workbook you copied data from
Filename = Dir
Loop
wb2.Close True 'no close and save master file
End Sub
Please, test it and send some feedback.