vba Excel：将工作簿复制到新工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20849877/
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
Excel: Copy workbook to new workbook
提问by SonOfAnubis
So prior to asking this I searched and found something that was similar to what I was looking to do here.
所以在问这个之前，我搜索并发现了一些与我在这里想做的事情类似的事情。
Basically I have workbook AlphaMaster. This workbook is a template that I want to use to create new workbooks from weekly.
基本上我有工作簿AlphaMaster。该工作簿是我想用来每周创建新工作簿的模板。
In this workbook there are sheets named: Monday-Saturday and additional sheets with a corresponding date for Mon, Tues, ect.
在此工作簿中，有名为：Monday-Saturday 的工作表和其他工作表，其对应的日期为 Mon、Tues 等。
I have created a Form that loads on open of the workbook. What I want is when I click form run it will:
我创建了一个在打开工作簿时加载的表单。我想要的是当我点击表单运行它会：
- Run Code saving template as new workbook
- Rename workbook based of input from userform1
Rename the workbooks with proper weekday
Workbook is named for a week end date dates of 6 sheets would renamed after this(example week ending 5th of Jan.) is put into user form as:
- 将代码保存模板作为新工作簿运行
- 根据来自 userform1 的输入重命名工作簿
使用适当的工作日重命名工作簿
工作簿被命名为 6 个工作表的一周结束日期日期将在此之后重命名（示例周结束于 1 月 5 日）被放入用户表单中：
WeekEnd: Jan-5-2014 Dates Mon:Dec.30 Tues:Dec.31 Weds:Jan.1 Thurs:Jan.2 Fri:Jan.3 Sat:Jan.4
周末：2014 年 1 月 5 日日期周一：12 月 30 日周二：12 月 31 日周三：1 月 1 日周四：1 月 2 日周五：1 月 3 日周六：1 月 4 日
Than click command. so far this is what I have:
比单击命令。到目前为止，这就是我所拥有的：
Private Sub CommandButton1_Click()
Dim thisWb As Workbook, wbTemp As Workbook
Dim ws As Worksheet
On Error GoTo dummkopf
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
Set wbTemp = Workbooks.Add
On Error Resume Next
For Each ws In wbTemp.Worksheets
ws.Delete
Next
On Error GoTo 0
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(1)
Next
wbTemp.Sheets(1).Delete
wbTemp.SaveAs "blahblahblah\New.xlsx"
new.xlsx i want to be filled in from form
new.xlsx 我想从表格中填写
Vorfahren:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Vorfahren
End Sub
Complications:
并发症：
Currently while this does work I cant change the name of the document its named what I name it in the .saveAs area. I'm thinking I need to create an alternate function to handle this. Second, when it finishes my sheets are displayed in the reverse order of the template.
目前，虽然这确实有效，但我无法更改其在 .saveAs 区域中命名的文档名称。我想我需要创建一个替代函数来处理这个问题。其次，当它完成时，我的工作表以与模板相反的顺序显示。
Some guidance/suggestions on where to go from here would be greatly appreciated!
将不胜感激关于从这里去哪里的一些指导/建议！
回答by PatricK
A few issues here:
这里有几个问题：
You cannot delete all Worksheets in a Workbook.
您不能删除工作簿中的所有工作表。
You should copy the sheet to the end to retain order (if the worksheets in source workbook is sorted):
您应该将工作表复制到最后以保留顺序（如果源工作簿中的工作表已排序）：
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
wbTemp.Sheets(wbTemp.Sheets.Count).Name = "NewSheetName" ' <-- Rename the copied sheet here
Next
If your source Worksheets does not have names "Sheet#" then delete the default sheets afterwards.
如果您的源工作表没有名称“Sheet#”，则随后删除默认工作表。
Application.DisplayAlerts = False
For Each ws In wbTemp.Sheets
If Instr(1, ws.Name, "Sheet", vbTextCompare) > 0 Then ws.Delete
Next
Application.DisplayAlerts = True
For SaveAs, refer to Workbook.SaveAs Method (Excel).
对于 SaveAs，请参阅Workbook.SaveAs 方法 (Excel)。
回答by messed-up
I use this in my application and works good
我在我的应用程序中使用它并且效果很好
Set bFso = CreateObject("Scripting.FileSystemObject")
bFso.CopyFile ThisWorkbook.FullName, destinationFile, True
Once it's copied you can then open it in new Excel Object and do what ever you want with it.
一旦它被复制，你就可以在新的 Excel 对象中打开它并用它做任何你想做的事情。
