创建工作表数组而不是变体

时间:2019-06-02 14:32:11

标签: arrays excel vba

我想创建一个工作表类型的数组,而不是变体,然后使用Array函数填充该数组,最后将该数组传递给worksheet.copy函数,以在数组变量中创建工作表的新工作簿。 / p>

以下代码有效,但没有一个数组属于工作表类型,并且两个示例数组都填充了工作表名称。

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 :(得分:0)

虽然您可以创建工作表数组,但是一次全部复制都行不通(尽管您可以循环复制它们)。如果要一次复制多张纸,可以使用名称数组。

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