如何使用VBA将多个工作表复制到新工作簿中

我正在尝试为报表创build另存为function。 目前主表有25个标签。 我正在寻找25的23中复制到一个每日保存链接到一个特定的文件夹。

此外,我正在寻找第二个保存链接到不同的文件夹位置。

不过,我目前已经内置了一个错误消息警告框,阻止用户能够保存文件,使他们无法混淆它。

Sub SaveMain() Application.EnableEvents = False 'Stop ThisWorkbook VBA currently blocking the user being able to Save Dim FlName As String Dim FilePath As String Dim NewWkBk As Workbook Dim FileDate As String FlName = " September Reporting" & InputBox("Enter Yesterday's Date DD/MM/YYYY:", "Creating New File...") & ".xlsb" FilePath = "Z:\Call Agent Brief\Reporting\September Reporting\Reports" Set NewWkBk = Workbooks.Add Windows("September Reports Calculator - MASTER COPY.xlsb").Activate Sheets(Array("Admin Tab", "Home Tab", "Dashboard", "Drop Down Values", _ "Reports Home", "Deployments", "Daily Summary", "Daily Breakdown", _ "Monthly Summary", "Monthly Breakdown - Title Page", "Monthly Breakdown", _ "Monthly Rolling 12 Months", "Monthly Cancellations", "Non-Deployments", _ "Non-Deployments Summary", "Non-Deployments Breakdown", "FNOL", "FNOL Summary", _ "FNOL Breakdown", "FNOL Deployments by User", "FNOL Deployments by Team", _ "FNOL Deployments by Insurer", "FNOL Non-Deployed Opportunities")).Copy After:=Workbooks(NewWkBk) NewWkBk.SaveAs FilePath & "\" & FlName, FileFormat:=xlsb Application.EnableEvents = True End Sub 

运行macros时正确加载date条目的窗体,但会出现运行时错误消息。

运行时错误“13”:types不匹配

debugging突出显示长Sheets copy行。 即使当我限制它复制只有一个选项卡它回来了同样的问题。

我不能简单地将值粘贴到一个新的工作表,因为在主表中有很多格式devise,使这个用户友好。 据我所知,唯一的办法是把整个表格复制到一个新的。

此代码仅用于创build第一个保存文件(主要的23选项卡之一)。 第二个我希望创build第二个macros使用相同的过程,这显然是不同的选项卡名称。

你会遇到一些问题,我想你正在命名文件,从一个空格开始,在名称中使用“/”。 一旦你解决了,我认为这将工作:

 Sub SaveMain() Application.EnableEvents = False 'Stop ThisWorkbook VBA currently blocking the user being able to Save Dim FlName As String Dim FilePath As String Dim NewWkBk As Workbook Dim FileDate As String FlName = "September Reporting" & InputBox("filename ", "Creating New File...") & ".xlsb" FilePath = "C:\users\adm123\documents\xlworking" Sheets(Array("Admin Tab", "Home Tab", "Dashboard", "Drop Down Values", _ "Reports Home", "Deployments", "Daily Summary", "Daily Breakdown", _ "Monthly Summary", "Monthly Breakdown - Title Page", "Monthly Breakdown", _ "Monthly Rolling 12 Months", "Monthly Cancellations", "Non- Deployments", _ "Non-Deployments Summary", "Non-Deployments Breakdown", "FNOL", "FNOL Summary", _ "FNOL Breakdown", "FNOL Deployments by User", "FNOL Deployments by Team", _ "FNOL Deployments by Insurer", "FNOL Non-Deployed Opportunities")).Copy newfilename = FilePath & "\" & FlName With ActiveWorkbook .SaveAs newfilename, FileFormat:=50 .Close 0 End With Application.EnableEvents = True End Sub