使用 VBA 将整个 Excel 工作簿复制到另一个工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14618540/
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
Copying an entire excel workbook to another workbook using VBA
提问by KiwiRyu
I have a workbook with 4 worksheets ("Initial Workbook").
I need to copy all four worksheets to a different workbook("New Workbook").
我有一个包含 4 个工作表的工作簿（“初始工作簿”）。
我需要将所有四个工作表复制到不同的工作簿（“新工作簿”）。
I have the below code which allows me to navigate to the Initial Workbook from the New Workbook and then copy a specific range on one worksheet. I would like to amend this to allow me to select and copy all four of the worksheets on the Original Worksheet.
我有以下代码，它允许我从新工作簿导航到初始工作簿，然后在一张工作表上复制特定范围。我想修改它以允许我选择和复制原始工作表上的所有四个工作表。
Any help you can provide would be most appreciated:
您可以提供的任何帮助将不胜感激：
Private Sub CommandButton1_Click()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2002-03", "*.xls", 1
.Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="$A:$CS", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub
回答by Orina
works like a charm:
奇迹般有效：
ActiveWorkbook.Sheets.Copy
（来源：http: //www.mrexcel.com/forum/excel-questions/404450-visual-basic-applications-copy-active-workbook-new-workbook.html）
回答by Jeremy Morren
I know this is an old post, but the existing answers only copy Sheets (excluding Queries etc), and do so very inefficiently. The below code works like a charm for me:
我知道这是一篇旧帖子，但现有答案仅复制表格（不包括查询等），并且效率很低。下面的代码对我来说就像一个魅力：
Function duplicateWorkbook(wk As Workbook) As Workbook
Dim path As String
path = Environ("temp") & "\" & wk.Name & "." & _
Right(wk.FullName, Len(wk.FullName) - InStrRev(wk.FullName, "."))
wk.SaveCopyAs path
Set duplicateWorkbook = Workbooks.Add(path)
Kill path
End Function
To use, simply call it as below:
要使用，只需如下调用它：
Dim wk AS Workbook: Set wk = duplicateWorkbook(ActiveWorkbook)
The code saves a temporary copy of the workbook in the temp Folder, creates a new workbook using the temporary book as a template, and then deletes the temporary workbook.
该代码将工作簿的临时副本保存在临时文件夹中，使用临时工作簿作为模板创建一个新工作簿，然后删除临时工作簿。
回答by Peter Albert
This reworked code should copy your worksheets:
这个重新设计的代码应该复制你的工作表：
Private Sub CommandButton1_Click()
Dim wkbSource As Workbook
Dim wkbTarget As Workbook 'better use source and target as names, as its less confusing
Dim strFileName As String
Set wkbSource = ActiveWorkbook
strFileName = Application.GetOpenFilename( _
"Excel 2002-03 (*.xls), *.txt, " & _
"Excel 2007 (*.xlsx; *.xlsm; *.xlsa), *.xlsx; *.xlsm; *.xlsa")
If strFileName = "False" Then Exit Sub 'make sure that your locale also returns False!
Set wkbTarget = Workbooks.Open(strFileName)
wkbSource.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Copy _
Before:=wkbTarget.Sheets(1)
'Further editing goes here
wkbTarget.Close False
End Sub
Just replace the sheet names according to your needs.
只需根据您的需要替换工作表名称。
(PS: You can find these commands yourself, if you simply record a macro where you copy the sheets to another workbook - and then look at the produced code! ;-) )
（PS：你可以自己找到这些命令，如果你只是记录一个宏，将工作表复制到另一个工作簿 - 然后查看生成的代码！;-)）
