2016-09-06 116 views
0

我遇到麻烦找出我的代码问题。我正在运行一个文件夹,根据文件名创建工作表,复制单个单元格(A1)并将其传递到新工作表中。不过,我一直得到以下错误:工作簿之间的复制/粘贴(下标超出范围)

Subscript out of range (Run-time error '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 

有人能看到什么是错的代码?提前致谢。

+1

不知道是什么行中出现的错误,但试试这个:'文件= DIR(ThisWorkbook.Path& “\部门\ * XLSX。”)''的'字符会返回一个名为'所有文件例如,该文件夹中的.xlsx'。实际上,我认为答案是您需要先打开工作簿,然后才能将任何范围值复制到该工作簿。因此,在复制方法之前插入一个'Workbooks.Open'方法。 (留下第一部分,以防它有帮助)。 –

+0

如果您尝试使用的项目不在集合中,则会在您的任何“Sheets()”或“Workbooks()”访问中弹出此错误。检查'ThisWorkbook.Path&“\ Departments \”&file'的值以确保它是已打开工作簿的名称。检查工作簿是否有名为“XXX”的工作表,并检查您的ActiveWorkbook是否有名为“WS.Name”的工作表 – Mikegrann

回答

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 
+0

我建议添加关于为什么这将有助于OP的说明。 – Chrismas007

+0

只是一个个人的调整 - 因为OP只是想要的值,你可以完全跳过'.Copy',只需设置两个范围相等:'wsOutput.Range(“A1”)。Value = wbSource.Sheets(“XXX” ).Cells.Value'。 (这应该起作用,否则,你只需要将两个范围的大小相等)。 – BruceWayne

+0

我没有设置范围,因为根据源表中有多少数据可能会导致“内存不足”错误。 – Coolshaikh

相关问题