方法Open作用于对象Worbooks时失败，第二个Open

Question

Sub MoveSheet()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim FolderPath As String, FileType As String, FileName As String, WriteToPath As String
FolderPath = Environ("userprofile") & "\Desktop\盘点数据" '读取桌面上的文件夹"盘点数据"的路径
WriteToPath = Environ("userprofile") & "\Desktop\审批数据" '读取做面上的文件夹"审批数据"的路径
FileType = "*.xlsx" '定义需要遍历的文件类型
FileName = VBA.Dir(FolderPath & FileType)

Dim FindWorkBook As Workbook, WriteToBook As Workbook, SheetCount As Long
Do Until FileName = ""
Set FindWorkBook = Workbooks.Open(FolderPath & FileName)
Set WriteToBook = Workbooks.Open(WriteToPath & Left(FileName, 4) & " 审批表.xlsx") '"审批表"可以按自定义修改
'将盘点表第一张表的数据拷贝到审批表的第二张中
SheetCount = WriteToBook.Sheets.Count
If SheetCount < 2 Then WriteToBook.Worksheets.Add after:=Sheets(Sheets.Count) '如果审批表中只有一张工作表就再创建一张新的工作表
FindWorkBook.Worksheets(1).Cells.Copy WriteToBook.Worksheets(2).Range("A1")
'关闭工作薄
FindWorkBook.Close savechanges:=True
WriteToBook.Close savechanges:=True
FileName = VBA.Dir '遍历下一个表
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

​

Answer 1

你好，我是有问必答小助手，非常抱歉，本次您提出的有问必答问题，技术专家团超时未为您做出解答


本次提问扣除的有问必答次数，将会以问答VIP体验卡（1次有问必答机会、商城购买实体图书享受95折优惠）的形式为您补发到账户。


因为有问必答VIP体验卡有效期仅有1天，您在需要使用的时候【私信】联系我，我会为您补发。