Question

我在解决代码问题时遇到了麻烦。我正在浏览文件夹，根据文件名创建工作表，复制单个单元格（A1）并将其传递到新工作表中。但是，我一直收到以下错误：

下标超出范围（运行时错误'9'）

我有以下代码：

Sub InsertDepartments()
    Dim MyObj As Object, MySource As Object, file As Variant
    file = Dir(ThisWorkbook.Path & "\Departments\")
    While (file <> "")
        Set WS = Sheets.Add(After:=Sheets("Start"))
        WS.Name = Left(file, InStr(file, ".") - 1)

        Workbooks(ThisWorkbook.Path & "\Departments\" & file).Sheets("XXX").Range("A1").Copy
        Sheets(WS.Name).Range("A1").PasteSpecial Paste:=xlPasteValues

        file = Dir
    Wend

End Sub

任何人都可以看到代码中出现了什么问题吗？提前谢谢。

Answer 1

这应该可以解决问题。在执行复制/粘贴之前，您没有打开工作簿。

Sub InsertDepartments()
    Dim wbOutput As Workbook
    Dim wsOutput As Worksheet
    Dim wbSource As Workbook
    Dim file As Variant

    file = Dir(ThisWorkbook.Path & "\Departments\*.xls*")
    Set wbOutput = ActiveWorkbook

    While (file <> "")

        Set wsOutput = wbOutput.Sheets.Add(After:=wbOutput.Sheets("Start"))
        wsOutput.Name = Left(file, InStr(file, ".") - 1)
        Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Departments\" & file)
        wbSource.Sheets("XXX").Cells.Copy
        wsOutput.Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wbSource.Close False
        file = Dir
    Wend

End Sub

在工作簿之间复制/粘贴（下标超出范围）

1 个答案: