運行時錯誤9複製SEET時，一個新的wrokbook

我有一個簡單的代碼位，如下圖所示標越界：運行時錯誤9複製SEET時，一個新的wrokbook

Private Sub btn_conact_Click() 

Dim projectref As String 
Dim savelocation As String 
Dim projectSearchRange As Range 
Dim LastRow As Integer 

'set search value (porject key - unique)  
projectref = cmb_Project.Value 

Application.ScreenUpdating = False 
'find the project reference in the tracking spreadsheet 

Sheets("Project Tracking").Activate 
Set projectSearchRange = Range("A:A").Find(projectref, , xlValues, xlWhole) 
LastRow = projectSearchRange.Row 
'file directory to save the new workbook in 
savelocation = Cells(LastRow, 5).Value  

'template for the contact list 
Sheets("Contact List").Activate 

Cells(7, 3).Value = projectref 
'create new workbook 
Set newWorkbook = Workbooks.Add 
With newWorkbook 
    .Title = "Contact List for Project" & projectref 
    .SaveAs Filename:=savelocation & "/" & projectref & "Contact_List.xlsx" 
End With 

'Windows("Project tracker spreadsheet VBA").Activate 
Sheets("Contact List").Copy Before:=Workbooks(projectref & "Contact_List.xlsx").Sheets("Sheet1") 'runtime error 9: subscript out of range 
Windows(projectref & " Contact_List.xlsx").Activate 
Application.ScreenUpdating = True 

End Sub

可以看出，我得到的運行時錯誤第四最後一行代碼，這是一個非常重要的行...

我的問題是，任何人都可以看到我可能犯了一個錯誤，會導致這個錯誤嗎？已成功創建新工作簿並將其保存在指定位置，但只是在嘗試從舊工作簿（Project tracker spreadsheet VBA）複製所需工作表到此代碼創建的新工作簿時發生。

來源

2017-01-25 scb998

爲什麼註釋掉這一行'的Windows（「項目跟蹤電子表格VBA」）Activate'？刪除代碼中此行之前的單引號。 – sn152

「舊」工作簿的名稱是什麼？如果是「項目跟蹤器電子表格VBA.xlsm」，那麼你應該使用Workbooks（「項目跟蹤器電子表格VBA.xlsm」）表格（「聯繫人列表」）。複製之前：= Workbooks（projectref＆「Contact_List.xlsx 「）.Sheets（」Sheet1「）' – YowE3K

首先，關於你的錯誤，你已經定義和使用Set newWorkbook = Workbooks.Add設定新的工作簿，那麼爲什麼不使用它時，你「聯繫人列表」工作簿之間的表。

要複製工作簿之間的工作表，則需要完全限定Worksheet對象，ThisWorkbook.Sheets("Contact List").Copy Before:=NewWorkbook.Sheets("Sheet1")

其次，最好避免使用Activate時，你可以使用完全合格Range S和Worksheets直接工作。

全部編輯代碼：

Option Explicit 

Private Sub btn_conact_Click() 

Dim projectref As String 
Dim savelocation As String 
Dim projectSearchRange As Range 
Dim LastRow As Integer 
Dim NewWorkbook As Workbook 

'set search value (porject key - unique) 
projectref = cmb_Project.Value 

Application.ScreenUpdating = False 

'find the project reference in the tracking spreadsheet 
With Sheets("Project Tracking") 
    Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole) 
    If Not projectSearchRange Is Nothing Then '<-- verify that find was successful 
     LastRow = projectSearchRange.Row 
     'file directory to save the new workbook in 
     savelocation = .Cells(LastRow, 5).Value 
    Else '<-- find was unsuccessful 
     MsgBox "Unable to find " & projectref 
     Exit Sub 
    End If 
End With 

'template for the contact list 
Sheets("Contact List").Cells(7, 3).Value = projectref 

'create new workbook 
Set NewWorkbook = Workbooks.Add 
With NewWorkbook 
    .Title = "Contact List for Project" & projectref 
    .SaveAs Filename:=savelocation & "/" & projectref & "Contact_List.xlsx" 
End With 

' ===== Fixed the error on thie line ===== 
ThisWorkbook.Sheets("Contact List").Copy Before:=NewWorkbook.Sheets("Sheet1") 
NewWorkbook.Activate '<-- not sure why you want to Activate, but here you go 
Application.ScreenUpdating = True 

End Sub

來源

2017-01-25 06:51:33

輝煌 - 工作一種享受！感謝您的建議以及:) – scb998

我不知道如何在評論中插入代碼，所以使用答案空間來指導你。它顯示Windows（「項目跟蹤器電子表格VBA」）不可用。可能是窗口文本不正確。確認這一點。請在下面的代碼行插入該行已被註釋掉的地方。這可能會給你一些線索。

found = False 
    For Each Item In Windows 
    Debug.Print Item.Caption 
    If Item.Caption = "Project tracker spreadsheet VBA" Then 
     found = True 
     Exit For 
    End If 
    Next 

    If Not found Then 
    MsgBox "Window(Project tracker spreadsheet VBA) - Not found" 
    End If

來源

2017-01-25 06:42:03

運行時錯誤9複製SEET時，一個新的wrokbook

回答

相關問題