Макрос для копирования и / или перемещения выбранных листов в новую книгу

Question

Может кто-нибудь помочь мне с макросом? Я хочу переместить и / или скопировать несколько выбранных листов (скрытых и видимых) в новую рабочую книгу, но, поскольку у меня одновременно открыто несколько рабочих книг, я хочу иметь возможность выбирать рабочие листы во всех открытых рабочих книгах как капли вниз меню и переместить и / или скопировать в новую рабочую книгу. Я хочу переместить некоторые из них и скопировать некоторые листы, поэтому в окне выбора понадобятся оба параметра.

Пожалуйста, помогите, поскольку я сломал себе голову и ничего не получил.

Я попробовал следующее:

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