VBA - 运行时错误1004

时间:2012-11-05 18:27:38

标签: vba excel-vba excel-2007 excel

我正在尝试将特定工作表从已关闭的工作簿复制到我打开的工作簿的特定工作表,但我收到运行时错误。

代码如下:

Option Explicit

Sub START()


'Defining variables as a worksheet or workbook
Dim shBrandPivot As Worksheet
Dim shCurrentWeek As Worksheet
Dim shPriorWeek As Worksheet
Dim shPivot As Worksheet
Dim wkb As Workbook
Dim wkbFrom As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim path As String, FilePart As String
Dim TheFile
Dim loc As String

'Setting sheets to active or to recognize where to pull information
Set shBrandPivot = ActiveWorkbook.Sheets("Brand Pivot")
Set shCurrentWeek = ActiveWorkbook.Sheets("Current Week")
Set shPriorWeek = ActiveWorkbook.Sheets("Prior Week")
Set shPivot = ActiveWorkbook.Sheets("Pivot")
Set wkb = ThisWorkbook
loc = shPivot.Range("E11").Value
path = shPivot.Range("E12").Value
FilePart = Trim(shPivot.Range("E13").Value)
TheFile = Dir(path & "*" & FilePart & ".xls")
Set wkbFrom = Workbooks.Open(loc & path & TheFile)
Set wks = wkbFrom.Sheets("SUPPLIER_01_00028257_KIK CUSTOM")
Set rng = wks.Range("A2:N500")

'Copy and pastes This week number to last week number
shPivot.Range("E22:E23").Copy shPivot.Range("F22")

'Deletes necessary rows in PriorWeek tab
shPriorWeek.Range("A4:AC1000").Delete

'Copies necessary rows in CurrentWeek tab to PriorWeek tab
shCurrentWeek.Range("A4:AC1000").Copy shPriorWeek.Range("A4")

'Copies range from report generated to share drive and pastes into the current week tab of open order report
rng.Copy wkb.Sheets("Current Week").Range("A4")

'Closes the workbook in the shared drive
wkbFrom.Close False

End Sub

这分别是单元格E11,E12和E13:

E11 - S:_供应链\每周Rpts供应商和买家\ E12 - 102112 E13 - SUPPLIER_01_00028257_KIK定制产品GAINSVILLE_21-OCT-12.xls

我想打开已关闭工作簿的目录是S:_Supply Chain \ Weekly Rpts供应商和买方\ 102112 \ Supplier_01_00028257_KIK CUSTOM PRODUCTS GAINSVILLE_21-OCT-12.xls

2 个答案:

答案 0 :(得分:2)

我建议你阅读this

原因

  

当您为工作簿提供已定义的名称时,可能会发生此问题   然后多次复制工作表而不先保存和关闭   工作手册

如何解决

  

要解决此问题,请定期保存并关闭工作簿   复制过程正在进行中

有关聊天中讨论的摘要

Set wkbFrom = Workbooks.Open(loc & path & TheFile)

上设置断点

我们意识到文件名丢失导致Dir(path & "*" & FilePart & ".xls") 返回没有文件名的目录。

因此解决方案是添加单元格E13中的文件名

答案 1 :(得分:1)

我之前做过类似的事情可能对你有用。我的只复制一个范围,但您可以轻松地将范围的大小更改为您要复制的工作表上的已用空间量。

Dim source as Workbook
Dim dest As Workbook
Dim originalWorkBook As Workbook
Set originalWorkBook = ThisWorkbook
Dim ws As Worksheet
Dim copyRange As String
Dim myDir As String
'myDir is found via a function I wrote. The user enters a name, month and year and
'from there it knows where the file will be

copyRange = "A1:D80"

source.Worksheets("The name of your worksheet here").Range(copyRange).Copy
originalWorkBook.Activate
originalWorkBook.Worksheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
source.Close False
Application.ScreenUpdating = True

希望这有帮助。