Question

我是excel vba的新手，并创建了这个已经工作了几个月的代码，但突然之间已停止工作了。我在显示的最后一行编码中得到运行时错误9，并且无法解决错误。

Sub BuildInsulationMTO_Click()

    Application.ScreenUpdating = False

    Dim wbTarget As Workbook
    Dim wbSource As Workbook
    Dim wbSourceFNameandPath As Variant 'Source data file name and path
    Dim wbTargetFNameandPath As Variant 'Target file name and path
    Dim a As Integer 'used to increment wbTarget file name
    Dim x As Integer 'used in H1 C1 description section

    Dim i As Integer 'Row of Source MTO
    Dim j As Integer 'Row of Source Raw MTO
    Dim k As Integer 'Row of Target File
    Dim LastRowSource As Long 'Rows in source sheet
    Dim LastRowTarget As Long 'Rows in target sheet, prior to row deletion
    Dim y As Long

    wbTargetFNameandPath = "L:\15.0 Engineering\LNG 1\15.0 Project Work Packs\15.10 IFS Job Cards\TempMTO\IFS Insulation MTOs\" & Format(Date, "yyyymmdd") & "_IFSInsulationMTO.xlsx"
    a = 2

    Do While Dir(wbTargetFNameandPath) <> "" 'If target file name exists, creates incremented file name and loops til this new name doesnt already exist
        wbTargetFNameandPath = "L:\15.0 Engineering\LNG 1\15.0 Project Work Packs\15.10 IFS Job Cards\TempMTO\IFS Insulation MTOs\" & Format(Date, "yyyymmdd") & "_IFSInsulationMTO_V" & a & ".xlsx"
        a = a + 1
    Loop

    Workbooks.Add 'create & save target excel file
    ActiveWorkbook.SaveAs Filename:=wbTargetFNameandPath
    Close

    wbSourceFNameandPath = Application.GetOpenFilename(Title:="Select Source Data Excel File") 'select source data file
    If wbSourceFNameandPath = False Then Exit Sub
    Set wbSource = Workbooks.Open(wbSourceFNameandPath, False)
    Set wbTarget = Workbooks.Open(wbTargetFNameandPath)


'**************************************************************H1 C1***************************************************************************************************
    i = 5
    j = 3
    k = 2
    LastRowSource = wbSource.Sheets("MTO (C1 H1)").UsedRange.Rows.Count

    For i = 5 To LastRowSource
        'Job Card Number
        wbSource.Sheets("MTO (C1 H1)").Range("D" & i).Copy
        wbTarget.Sheets("Sheet1").Range("A" & k & ":A" & k + 16).PasteSpecial Paste:=xlPasteValues

Answer 1

您的问题是由于您使用了Close。

Close是一个VBA语句，用于关闭使用VBA Open语句打开的文件。（MSDN reference）这不是关闭工作簿的声明。

因为您在执行wbTargetFNameandPath后没有使用名称SaveAs关闭工作簿，所以当您收到声明时，它仍然处于打开状态：

Set wbTarget = Workbooks.Open(wbTargetFNameandPath)

当用于尝试打开已打开的工作簿时，该语句将wbTarget设置为引用ThisWorkbook（我认为，这是您的“源”工作簿）。

所以，要解决问题，请更改

Close

到

ActiveWorkbook.Close

另一种方法是使用wbTarget从您创建工作簿的那一刻起引用该工作簿，而不必费心关闭并重新打开它：

Set wbTarget = Workbooks.Add 'create & save target excel file
wbTarget.SaveAs Filename:=wbTargetFNameandPath

wbSourceFNameandPath = Application.GetOpenFilename(Title:="Select Source Data Excel File") 'select source data file
If wbSourceFNameandPath = False Then Exit Sub
Set wbSource = Workbooks.Open(wbSourceFNameandPath, False)

'**************************************************************H1 C1***************************************************************************************************

Answer 2

不同版本的Excel对新工作表具有不同的命名约定。也许Excel的版本已经改变。

更改此行以使用Sheet Index而不是Sheet name应该可以修复错误。

wbTarget.Sheets("Sheet1").Range("A" & k & ":A" & k + 16).PasteSpecial Paste:=xlPasteValues

 wbTarget.Worksheets(1).Range("A" & k & ":A" & k + 16).PasteSpecial Paste:=xlPasteValues

在您的代码工作后，我建议将其发布到CodeReview。

Excel VBA：从一个工作簿粘贴到另一个工作簿时出现错误9（下标超出范围）

2 个答案: