2016-09-06 107 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

相關問題