Question

我想知道是否有任何专家可以查看并告知我在下面的代码中做错了什么。我已经改编并修改了TheSpreadsheetGuru中的代码，它基本上打开了给定文件夹中的所有Excel电子表格，并将信息复制/粘贴到主电子表格中。

如果我打开主电子表格并运行宏，它实际上工作正常。但是，如果我首先清除主电子表格中的内容或多次运行宏，那么Excel就会自行关闭 - 我看不到任何明显错误的代码，所以如果你能告诉我什么，我将不胜感激任何帮助我做错了

提前致谢

Sub SI_Report() 
'PURPOSE: To copy strategic initiatives report into the master table
'SOURCE: Codes here are modified based on codes obtained from 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

Answer 1

尝试使用Option Explicit确保所有变量都已声明

运行VBA宏时Excel意外关闭（但有时只是）

1 个答案: