vba 用于将所选工作表复制和/或移动到新工作簿的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/6706003/
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
Macro to copy and/or move selected sheets to a new workbook
提问by Tue12
Can someone please help me with a macro? I want to move and/or copy a few selected sheets (hidden & visible) to a new workbook, but since I have a few workbooks open at a time, I want to be able to select worksheets in all open workbooks from like a drop down menu and move and/or copy to a new workbook. I want to move some and copy some worksheets so will need both options in selection box.
有人可以帮我做一个宏吗？我想将几个选定的工作表（隐藏和可见）移动和/或复制到新工作簿，但由于我一次打开了几个工作簿，我希望能够从所有打开的工作簿中选择工作表向下菜单并移动和/或复制到新工作簿。我想移动一些并复制一些工作表，因此需要选择框中的两个选项。
Please help as I have cracked my head on it and got nowhere.
请帮忙，因为我已经把我的头弄坏了，一无所获。
I have tried the below:
我尝试了以下方法：
Sub CopySheet()
Dim i As Integer, x As Integer
Dim shtname As String
'i = Application.InputBox("Copy how many times?", "Copy sheet", Type:=1)
'For x = 0 To i - 1
ActiveSheet.Copy After:=Sheets(Sheets.Count)
shtname = InputBox("What's the new sheet name?", "Sheet name?")
ActiveSheet.Name = shtname
'Next x
End Sub
But this will mean I have to type every sheet name every time.
但这意味着我每次都必须键入每个工作表名称。
Adam: While I try to run your code, it gives me an error - variable not specified in row Private Sub btnSubmit_Click()
亚当：当我尝试运行你的代码时，它给了我一个错误—— variable not specified in row Private Sub btnSubmit_Click()
How do I overcome it?
我该如何克服它？
I still can't get it right Adam. I am very new to Macros and I may be doing something wrong with interpreting your instructions. Can you please suggest something like all included in one and run?
我还是没弄明白亚当。我对宏很陌生，我可能在解释您的说明时做错了。你能建议像所有包含在一个中的东西并运行吗？
Where exactly in the original codes do I need to paste this code
我需要在原始代码中的哪个位置粘贴此代码
Private Sub btnSubmit_Click()
End Sub
回答by Adam Clason
This code should get you going. It is all of the code-behind for a UserForm with two listboxes, a checkbox, and a command button for submit. The dropdowns are populated automatically depending on what workbooks are open and what worksheets these workbooks contain. It also has the option to move or copy the selected worksheet. However, you still will need to add the functionality for copying the sheet multiple times, but that will just be a loop, and shouldn't be too difficult.
这段代码应该能让你继续前进。它是带有两个列表框、一个复选框和一个用于提交的命令按钮的用户窗体的所有代码隐藏。下拉列表会根据打开的工作簿以及这些工作簿包含的工作表自动填充。它还可以选择移动或复制选定的工作表。但是，您仍然需要添加多次复制工作表的功能，但这只是一个循环，应该不会太困难。
'All of this code goes in the section which appears when you right click
'the form and select "View Code"
Option Explicit
Public Sub OpenWorksheetSelect()
Dim WorksheetSelector As New frmWorksheetSelect
WorksheetSelector.Show
End Sub
Private Sub lstWorkbooks_Change()
FillWorksheetList
End Sub
Private Sub UserForm_Initialize()
FillWorkbookList
End Sub
Sub FillWorkbookList()
'Add each workbook to the drop down
Dim CurrentWorkbook As Workbook
For Each CurrentWorkbook In Workbooks
lstWorkbooks.AddItem CurrentWorkbook.Name
Next CurrentWorkbook
End Sub
Sub FillWorksheetList()
Dim WorkbookName As String
WorkbookName = lstWorkbooks.Text
If Len(WorkbookName) > 0 Then
Dim CurrentWorksheet As Worksheet
For Each CurrentWorksheet In Workbooks(WorkbookName).Sheets
lstWorksheets.AddItem CurrentWorksheet.Name
Next CurrentWorksheet
End If
End Sub
Private Sub btnSubmit_Click()
Dim WorkbookName As String, WorksheetName As String
WorkbookName = lstWorkbooks.Text
WorksheetName = lstWorksheets.Text
If Len(WorkbookName) > 0 And Len(WorksheetName) > 0 Then
If chkCopy = True Then
Workbooks(WorkbookName).Sheets(WorksheetName).Copy Before:=Workbooks.Add.Sheets(1)
Else
Workbooks(WorkbookName).Sheets(WorksheetName).Move Before:=Workbooks.Add.Sheets(1)
End If
End If
Unload Me
End Sub
