Help Identifying Coding Errors - Any Suggestions Greatly Appreciated

[zenjah]

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

[scottiex]

To all other users - Note this is the same issue reposted as this thread

http://www.excelforum.com/showthread...t=#post4553440