EliseFreedman
Programmer
I have a spreadsheet containing a macro which searches through a specified folder(containing several worksheet files) and combines all the files into a single spreadsheet.
At the moment, the code is set to combine all the files into the current workbook(i.e the one containing the macro)
Set Basebook=ThisWorkbook
I would prefer that a new workbook is opened and all the worksheet files are combined into this worksbook leaving the workbook containing the macro intact. However, I'm not entirely sure how to do this
Attached below is my complete code
----------------------------------------------------------
Sub Consolidate()
Dim Basebook As Workbook
Dim myBook As Workbook
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\GoodStockReturns"
.SearchSubFolders = False 'Change to true if need to search subfolders
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
Range("A1"
.CurrentRegion.Copy _
Basebook.Worksheets(1).Range("A65536"
.End(xlUp).Offset(1, 0)
myBook.Close
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub
At the moment, the code is set to combine all the files into the current workbook(i.e the one containing the macro)
Set Basebook=ThisWorkbook
I would prefer that a new workbook is opened and all the worksheet files are combined into this worksbook leaving the workbook containing the macro intact. However, I'm not entirely sure how to do this
Attached below is my complete code
----------------------------------------------------------
Sub Consolidate()
Dim Basebook As Workbook
Dim myBook As Workbook
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\GoodStockReturns"
.SearchSubFolders = False 'Change to true if need to search subfolders
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
Range("A1"
Basebook.Worksheets(1).Range("A65536"
myBook.Close
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub