VBA代码偶尔会崩溃

Question

我在excel中有一个宏，崩溃可能是我运行它的40％。它并不总是在同一步骤崩溃，如果我在崩溃后立即再次运行它，它总是完全运行。 Excel不会崩溃，但代码停止运行。代码运行时运行速度非常慢。是不是因为它陷入困境而崩溃了？我是VBA的初学者，所以我认为问题在于我的编码。有没有人有指针让我的代码达到不会崩溃的程度？该宏的目的是打开一个microsoft项目文件，将项目中的列复制并粘贴到excel中，然后使用excel文件中的公式计算最终报告。

Sub Update_Schedule()
Dim appProj As MSProject.Application
Dim aProg As MSProject.Project

Application.DisplayAlerts = False

'Clear current contents

Sheets("Master").Select
Columns("A:A").Select
Selection.ClearContents
Columns("B:B").Select
Selection.ClearContents
Columns("C:C").Select
Selection.ClearContents
Columns("D:D").Select
Selection.ClearContents
Columns("E:E").Select
Selection.ClearContents
Columns("F:F").Select
Selection.ClearContents
Sheets("Resource List").Select
Columns("A:A").Select
Selection.ClearContents
Columns("B:B").Select
Selection.ClearContents

'Open the Project file when it asks to open resource pool, press yes

Set appProj = CreateObject("Msproject.Application")

appProj.FileOpen "file to open.mpp"

Set aProg = appProj.ActiveProject

appProj.Visible = True

'Copy the project columns and paste into Excel

SelectSheet
OutlineShowAllTasks
OutlineShowAllTasks
SelectTaskColumn Column:="Name"
EditCopy
Sheets("Master").Select
Columns("A:A").Select
ActiveSheet.Paste
SelectTaskColumn Column:="Duration"
EditCopy
Columns("B:B").Select
ActiveSheet.Paste
SelectTaskColumn Column:="Start"
EditCopy
Columns("C:C").Select
ActiveSheet.Paste
SelectTaskColumn Column:="Finish"
EditCopy
Columns("D:D").Select
ActiveSheet.Paste
SelectTaskColumn Column:="Resource Names"
EditCopy
Columns("E:E").Select
ActiveSheet.Paste
SelectTaskColumn Column:="Project"
EditCopy
Columns("F:F").Select
ActiveSheet.Paste
WindowActivate WindowName:="File name is here.mpp"
SelectResourceColumn Column:="Name"
EditCopy
Sheets("Resource List").Select
Columns("A:A").Select
ActiveSheet.Paste
SelectResourceColumn Column:="Category"
EditCopy
Sheets("Resource List").Select
Columns("B:B").Select
ActiveSheet.Paste
WindowActivate WindowName:="file name here.mpp"

'Populates formula in Master sheet

Sheets("Master").Select
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G9223"), Type:=xlFillDefault
Range("G2:G9223").Select
ActiveWindow.ScrollRow = 1
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H9223"), Type:=xlFillDefault
Range("H2:H9223").Select
Calculate
Application.DisplayAlerts = True
End Sub