表数组下标超出范围

Question

我正在创建一个宏，它将从一个更大的工作簿中选择工作表，移动和保存这些工作表作为一个新的工作簿，然后移动到下一个集。

我创建了一个带有开始和结束值（由工作表索引号指定）的伪“数组”。

我遇到了一个“下标超出范围”的错误，在完成保存文件的部分后，但在将拉出下一组工作表的循环之前。

Dim Start As Integer
Dim Finish As Integer
Dim SR As Integer  
Dim SC As Integer
Dim ER As Integer
Dim EC As Integer
SR = 2
SC = 5
ER = 2
EC = 6
Start = Sheets("REF").Cells(SR, SC).Value
Finish = Sheets("REF").Cells(ER, EC).Value
Dim sheetArray() As Double
Dim i As Integer
Dim c As Integer
i = 0
c = Start
lastrow = Cells(100, SC).End(xlUp).Row

Do Until SR = lastrow

    Do Until c > Finish
        ReDim Preserve sheetarray (0 to i)
        i = i + 1
        c = c + 1
    Loop

    Sheets(sheetarray).Copy
    ActiveWorkbook.SaveAs Filename:= _ XXXXXXXXXXXXXXXXXX

    C = Start
    i = 0
    SR = SR + 1
    ER = ER + 1
Loop

ReDim sheetArray(i)

Do Until c > Finish
    ReDim Preserve sheetArray(i)
    sheetArray(i) = c
    i = i + 1
    c = c + 1

Loop



Sheets(sheetArray).Copy
ActiveWorkbook.SaveAs Filename:= _
    XXXXXXXXXXXXX

c = Start
i = 0
SR = SR + 1
ER = ER + 1

循环

Answer 1

这里需要三样东西：

1. 在加载每个工作表索引之前重新划分数组，因为现在的方法只是在每个循环上构建，因此从第二个循环开始就会出现下标超出范围错误--因为例如，数组基本上有1 3 5从第一个循环开始，然后有1 3 5从第一个循环开始，然后有1 3 5从第二个循环开始，然后有3 7从第二个循环开始。
2. 每次设置数组的值。您只设置数组的元素
3. 限定从哪个工作簿复制工作表，因为每次复制工作表都会将活动工作簿设置为新复制的工作簿。

构建do循环块，如下所示：

Do Until SR = lastrow

    ReDim sheetArray(0) 'or you can put i here since you set it to zero at the bottom

    Do Until c > Finish

        ReDim Preserve sheetArray(i)
        sheetArray(i) = c

        i = i + 1
        c = c + 1

    Loop

    Workbooks("myWkb").Sheets(sheetArray).Copy 'where myWkb is the workbook name you need ... you can also use ThisWorkbook (meaning the workbook where the code is running) but this is not best practice
    ActiveWorkbook.SaveAs Filename:="XXXXXXXXXXXXXXXXXX"

    c = Start
    i = 0
    SR = SR + 1
    ER = ER + 1

Loop