VBA - 运行时错误 1004

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/13238096/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 18:21:42  来源:igfitidea点击:

VBA - Run Time Error 1004

vbaexcel-vbaexcel-2007excel

提问by kmiao91

I am attempting to Copy a specific sheet from a closed workbook to a specific sheet to my opened workbook but I am receiving a run-time error.

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

The code is below:

代码如下:

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

This is what is in cell E11, E12 and E13 respectively:

这分别是单元格 E11、E12 和 E13 中的内容:

E11 - S:_Supply Chain\Weekly Rpts Supplier and Buyer\ E12 - 102112 E13 - SUPPLIER_01_00028257_KIK CUSTOM PRODUCTS GAINSVILLE_21-OCT-12.xls

E11 - S:_Supply Chain\Weekly Rpts Supplier and Buyer\ E12 - 102112 E13 - SUPPLIER_01_00028257_KIK CUSTOM PRODUCTS GAINSVILLE_21-OCT-12.xls

The directory I wish to open the closed workbook is S:_Supply Chain\Weekly Rpts Supplier and Buyer\102112\Supplier_01_00028257_KIK CUSTOM PRODUCTS GAINSVILLE_21-OCT-12.xls

我想打开关闭的工作簿的目录是 S:_Supply Chain\Weekly Rpts Supplier and Buyer\102112\Supplier_01_00028257_KIK CUSTOM PRODUCTS GAINSVILLE_21-OCT-12.xls

回答by Marc

I recommend you read this

我建议你读这个

Cause

原因

This problem can occur when you give the workbook a defined name and then copy the worksheet several times without first saving and closing the workbook

当您为工作簿指定一个定义的名称,然后在没有先保存和关闭工作簿的情况下多次复制工作表时,可能会出现此问题

How to Resolve

如何解决

To resolve this problem, save and close the workbook periodically while the copy process is occurring

要解决此问题,请在复制过程发生时定期保存并关闭工作簿

For a summary of the discussion in the chat

有关聊天中讨论的摘要

By setting a breakpoint on Set wkbFrom = Workbooks.Open(loc & path & TheFile)

通过设置断点 Set wkbFrom = Workbooks.Open(loc & path & TheFile)

We realized that the file name was missing cause Dir(path & "*" & FilePart & ".xls")returns the directory without the file name.

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

So the solution is to add the file name which is in the cell E13

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

回答by Lift

I've done a similar thing before which might be of use to you. Mine only copies a range, but you can easily change the size of the range to the amount of used space on the sheet you wish to copy.

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

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

Hope this helps.

希望这可以帮助。