Hi there, I am wondering if there are any experts that can have a look and advise what I am doing wrong with the codes below. I've adapted the codes from www.TheSpreadsheetGuru.com which basically opens up all the Excel spreadsheets in a given folder and copy/paste the information into the master spreadsheet.
If I open my master spreadsheet and run the macro it actually works fine. However, if I clear the contents in the master spreadsheet first or run the macro more than once then Excel would just shut itself down - I can't see anything that's obviously wrong with the codes so would appreciate any help with this
Thanks in advance
Sub SI_Report()
'PURPOSE: To copy strategic initiatives report into the master table
'SOURCE: Codes here are modified based on codes obtained from www.TheSpreadsheetGuru.com
Check = MsgBox("This will copy all the strategic initiatives from spreadsheets stored in a folder you will now choose, are you sure?", vbOKCancel)
If Check = vbOK Then
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'Optimise Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
' Clear contents first
Windows("Strategic Initiatives Master.xlsm").Activate
Sheets("Strategic Initiatives").Select
Range("A2:W201").Select
Selection.ClearContents
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile, UpdateLinks:=0)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Copy data
wb.Sheets("Strategic Initiatives").Select
Range("A2", Range("W2").End(xlDown)).Select
Selection.Copy
'Paste data
Windows("Strategic Initiatives Master.xlsm").Activate
Sheets("Strategic Initiatives").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Close Workbook without Saving
wb.Close SaveChanges:=False
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
Sheets("Instruction").Select
ResetSettings:
'Reset Macro Optimisation Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Else: Exit Sub
End If
End Sub
Bookmarks