Laufzeitfehler 9 - außerhalb des zulässigen Bereichs Tiefstellung, wenn ein seet zu einem neuen wrokbook Kopieren

Question

ich ein einfaches Stück Code haben, wie unten dargestellt:

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 

Wie man sehen kann, erhalte ich einen Laufzeitfehler auf der 4. letzte Zeile Code, die wirklich eine ziemlich wichtige Linie ist ...

Meine Frage ist, kann jemand sehen, wo ich möglicherweise einen Fehler gemacht haben könnte, die diesen Fehler verursachen würde? erstellt und speichert die neue Arbeitsmappe erfolgreich am angegebenen Speicherort, fällt jedoch beim Versuch, das erforderliche Arbeitsblatt aus der alten Arbeitsmappe (Projekt-Tracker-Arbeitsmappe VBA) in das neue Arbeitsblatt, das mit diesem Code erstellt wurde, zu kopieren.

Answer 1

Zuerst Ihre Fehler in Bezug auf, sind Sie bereits definiert, und die neue Arbeitsmappe mit Set newWorkbook = Workbooks.Add Einstellung, also warum es nicht verwenden, wenn Sie „Kontaktliste“ Blatt zwischen Arbeitsmappen.

ein Arbeitsblatt zwischen Arbeitsmappe zu kopieren, müssen Sie vollständig das Worksheet Objekt,

Zweiter qualifizieren ThisWorkbook.Sheets("Contact List").Copy Before:=NewWorkbook.Sheets("Sheet1"), es besser ist, mit Activate zu vermeiden, wenn Sie direkt mit qualifizierten Range s und Worksheets arbeiten können.

Voll Edited-Code:

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 

Answer 2

Ich weiß nicht, wie Sie Code in Kommentare einfügen, so dass Sie die Antworten verwenden, um Sie zu führen. Es scheint, Windows ("Project Tracker Tabellenkalkulation VBA") ist nicht verfügbar. Möglicherweise ist der Fenstertext falsch. Um dies zu bestätigen. Bitte fügen Sie die folgenden Codezeilen ein, in denen die Zeile auskommentiert wurde. Dies kann Ihnen einen Hinweis geben.

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