Создать массив рабочих листов не вариант - PullRequest
0 голосов
/ 02 июня 2019

Я хотел бы создать массив листа типа, а не варианта, затем заполнить массив, используя функцию Array, и, наконец, передать массив в функцию worksheet.copy, чтобы создать новую книгу рабочих листов в переменных массива.

Следующий код работает, но ни один из массивов не относится к типу листа, а два примера массивов заполнены именами листа.

Dim wbkThis         As Workbook
Dim wstX            As Worksheet
Dim wstY            As Worksheet
Dim wstZ            As Worksheet
Dim arrWSA          As Variant
Dim arrWSB()        As Variant
Dim arrWSC(1 To 3)  As Variant

Cancel = True

Set wbkThis = ThisWorkbook
Set wstX = wbkThis.Worksheets("SheetX")
Set wstY = wbkThis.Worksheets("SheetY")
Set wstZ = wbkThis.Worksheets("SheetZ")
ReDim arrWSA(1 To 3) As Variant
ReDim arrWSB(1 To 3) As Variant

arrWSA = Array(wstX, wstY, wstZ)
arrWSB = Array(wstX.Name, wstY.Name, wstZ.Name)
arrWSC(1) = wstX.Name
arrWSC(2) = wstY.Name
arrWSC(3) = wstZ.Name

arrWSA(1).Copy
Worksheets(arrWSB()).Copy
Worksheets(arrWSC()).Copy

1 Ответ

0 голосов
/ 02 июня 2019

Несмотря на то, что вы можете создать массив рабочих листов, копировать их все сразу не получится (хотя вы можете скопировать их в цикле). Если вы хотите скопировать несколько листов одновременно, вам нужно использовать массив имен.

Sub CopySheets()
    Dim shtCount As Long: shtCount = Worksheets.Count
    Dim X As Long

    Dim arrSheets() As Worksheet: ReDim arrSheets(1 To shtCount)

    For X = LBound(arrSheets) To UBound(arrSheets)
        Set arrSheets(X) = Worksheets(X)
    Next X

'    Worksheets(arrSheets).Copy After:=Worksheets(shtCount) 'This won't work.

    For X = LBound(arrSheets) To UBound(arrSheets)
        arrSheets(X).Copy After:=Worksheets(shtCount) 'this will
    Next X


    Dim arrShtNames() As String: ReDim arrShtNames(1 To shtCount)
    For X = LBound(arrShtNames) To UBound(arrShtNames)
        arrShtNames(X) = Worksheets(X).Name
    Next X

    Worksheets(arrShtNames).Copy After:=Worksheets(shtCount) 'this will as well

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...