用於將選定工作表復制和/或移動到新工作簿的宏

Question

有人可以幫我做一個宏嗎？ 我想將一些選定的工作表（隱藏和可見）移動和/或復制到一個新的工作簿，但由於我一次打開了幾個工作簿，我希望能夠在所有打開的工作簿中從 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

但這意味着我每次都必須輸入每個工作表名稱。

亞當：當我嘗試運行您的代碼時，它給了我一個錯誤 - variable not specified in row Private Sub btnSubmit_Click()

我該如何克服它？

我仍然無法正確解決亞當。 我對宏很陌生，我可能在解釋你的指令時做錯了。 你能推薦一些像所有東西都包含在一個中並運行的東西嗎？

我需要在原始代碼中的確切位置粘貼此代碼

Private Sub btnSubmit_Click()

End Sub

Answer 1

這段代碼應該可以幫助您。 它是包含兩個列表框、一個復選框和一個用於提交的命令按鈕的用戶窗體的所有代碼隱藏。 下拉列表會根據打開的工作簿以及這些工作簿包含的工作表自動填充。 它還可以選擇移動或復制選定的工作表。 但是，您仍然需要添加多次復制工作表的功能，但這只是一個循環，應該不會太難。

'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