macros复制和/或移动选定的工作表到一个新的工作簿

有人可以帮助我一个macros吗？ 我想移动和/或复制一些选定的工作表（隐藏和可见）到一个新的工作簿，但由于我一次打开几个工作簿，我希望能够从所有打开的工作簿中select工作表下拉菜单并移动和/或复制到一个新的工作簿。 我想移动一些和复制一些工作表，所以需要在select框中的两个选项。

请大家帮忙，因为我已经把我的头撞了一下，并没有得到。

我已经尝试了以下内容：

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 

但是这意味着我必须每次input每个表的名字。

亚当：当我尝试运行你的代码，它给了我一个错误 – variable not specified in row Private Sub btnSubmit_Click()

我如何克服它？

我仍然不能正确的亚当。 我对macros很新，我可能在解释你的指令时做错了什么。 你可以请build议像所有包括在一个和运行？

我在哪里需要粘贴这些代码

 Private Sub btnSubmit_Click() End Sub 

Answer 1

这个代码应该让你去。 这是UserForm的所有代码隐藏，包含两个列表框，一个checkbox和一个用于提交的命令button。 下拉列表将根据打开的工作簿以及这些工作簿包含的工作表自动填充。 它也可以select移动或复制选定的工作表。 但是，您仍然需要添加多次复制工作表的function，但这只是一个循环，不应该太困难。

 '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