我希望复制active Excel表(用户当前手动选择的Excel表),并将其保存为工作簿到指定的文件夹中。
我正在使用我知道的代码(它是从另一个用户复制的)。每当代码到达ActiveSheet.Copy行时,它都会停止并显示路径/文件访问错误(错误75)。
如果删除ActiveSheet.Copy代码行,代码可以正常工作,但它会将整个工作簿保存到文件夹中,而不是活动工作表。我注意到,如果我尝试在Excel中手动将工作表复制到新的工作簿,这对于.xlsx工作簿来说很好,但是如果工作簿是.xlsm,则手动处理不能工作。
是明确的,的手动过程是:
右键单击tab/worksheet
中选择"new book“
这应该会创建一个新的工作簿与您选择的工作表。提供给我在其机器上工作的代码的同一个人能够手动将工作表复制到新的工作簿,甚至可以从具有.xlsm扩展的工作簿中复制。
我有一个全新的ThinkPad,我没有改变任何默认设置。我已经在网上寻找这个问题的帮助,但找不到任何相关的答案。这似乎是某种设置问题,因为代码和手动处理在我的朋友计算机上工作,但不在我的电脑上。
5月30日更新:感谢您的回复和格式化帮助。在这个新的更新中,我尝试遵守格式化约定。
当代码到达ActiveSheet.Copy行并停止时,以下是事件的顺序:
ActiveSheet.Copy代码行的黄色。不再显示消息。请注意:我在Workbook.xlsm中的一个驱动器上运行代码,并试图保存到我的计算机上的本地驱动器。当我删除ActiveSheet.Copy代码行时,我能够将整个workbook.xlsm保存到适当的文件夹中,从而使我认为这不是路径问题。
但是,当我将带有代码的workbook.xlsm移动到本地驱动器时,我能够使用ActiveSheet.Copy代码行成功地运行宏。这发生在昨天我发表了我最初的问题之后。我发现,当我手动单击一个选项卡(工作表)将其复制并保存到一个新的工作簿时,只要它在本地驱动器上,它对workbook.xlsm也是有效的。
当我删除workbook.xlsm代码行时,我能够将整个ActiveSheet.Copy(而不是工作表)保存到本地C:从一个驱动器中驱动。这使我认为这不是路径问题,因为我能够保存到我指定的文件夹,我只是不能复制和保存一个工作表。我不认为情况已经结束,并且仍然难以理解: 1)为什么我不能从One驱动器运行带有ActiveSheet.Copy代码行的代码;2)为什么将工作表复制到新工作簿的手动过程在xlsm中不能在一个驱动器上工作,而是在本地驱动器上运行。
以下是代码:
Sub SaveMe()
'Application.ScreenUpdating = False
Dim MyTm As String 'Holds the Territory Manager "Code"
Dim MySavePath As Variant 'Holds the path to save the file
Dim MyFileName As String 'Holds the file name
Dim MyYear As Integer 'Holds the year
Dim MyMonth As Integer 'Holds the month
Dim MyDay As Integer 'Holds the day
MyYear = Year(Now)
MyMonth = Month(Now)
MyDay = Day(Now)
MyTm = Left(ActiveSheet.Name, 4)
MySavePath = Application.WorksheetFunction.VLookup(MyTm, Range("TMSavePath"), 2, False)
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
MySavePath & "\" & MyYear & MyMonth & MyDay & " - " & ActiveSheet.Name & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
'Application.ScreenUpdating = True
End Sub谢谢!
发布于 2020-05-29 12:17:09
试试下面的代码:
Sub moveActvieSheetToAnotherWB()
Application.DisplayAlerts = False
Dim wb As String
Dim sht As String
Dim newWb As Workbook
wb = ActiveWorkbook.Name
sht = ActiveSheet.Name
'
Set newWb = Workbooks.Add
Workbooks(wb).Sheets(sht).Copy before:=newWb.Sheets(1)
'disable popup before delete empty tab
Application.DisplayAlerts = False
newWb.Sheets(2).Delete
'full path
'newWb.SaveAs "newFilename.xlsx"
End Subhttps://stackoverflow.com/questions/62078247
复制相似问题