复制dynamic数组会导致下标超出范围错误

我正在尝试将工作表从主工作簿复制到目标工作簿，但是根据rngCurrent中的值是否存在于工作表名称中，我所复制的工作表是不同的。 出于某种原因，我在最后一行不断收到下标或范围错误。 任何人都可以帮我理解发生了什么事？

Sub test2() Dim wb As Workbook Dim master As Workbook Dim wbCurrent As Workbook Dim wbAdjustments As Workbook Dim wsName As Worksheet Dim rngEntityList As Range Dim rngCurrentEntity As Range Dim rngCurrent As Range Dim arrWorksheets As Variant Dim i As Integer Dim wsCount As Integer Set master = ThisWorkbook Set rngCurrentEntity = master.Sheets("File Info").Range("rng_Entity") 'named range of single entity Set rngEntityList = master.Sheets("Global").Range("rng_EntityList") 'list or entities Set rngCurrent = rngEntityList.Find(rngCurrentEntity.Value, LookIn:=xlValues) ' find single entity in the list If rngCurrent.Offset(, 4).Value = "FRP" Then 'find if it's FRP Set wb = Application.Workbooks("Foreign.xlsx") Else Set wb = Application.Workbooks("Domestic.xlsx") End If Dim ws() As String ' declare string array ReDim ws(wb.Worksheets.Count) As String ' set size dynamically Dim counter As Long ' running counter for ws array counter = 1 For i = 1 To wb.Worksheets.Count If InStr(1, wb.Worksheets(i).Name, rngCurrent.Value) <> 0 Then ws(counter) = wb.Worksheets(i).Name counter = counter + 1 End If Next ReDim Preserve ws(counter) As String ' Get rid of empty array entries wb.Worksheets(ws).Copy After:=master.Worksheets(master.Worksheets.Count) End Sub 

编辑我需要这样做的原因是因为我不想外部链接到源笔记本。

Answer 1

完整并经过testing的例子

 Sub Tester() Dim wb As Workbook, i As Long Set wb = ThisWorkbook Dim ws() As String ' declare string array ReDim ws(1 To wb.Worksheets.Count) As String ' set size dynamically Dim counter As Long ' running counter for ws array counter = 0 For i = 1 To wb.Worksheets.Count If InStr(1, wb.Worksheets(i).Name, "test") <> 0 Then counter = counter + 1 ws(counter) = wb.Worksheets(i).Name End If Next ReDim Preserve ws(1 To counter) wb.Worksheets(ws).Copy 'just makes a copy in a new workbook End Sub 

Answer 2

做这个：

 ReDim ws(1 To wb.Worksheets.count) As String ' set size dynamically, start from 1 Dim counter As Long ' running counter for ws array For i = 1 To wb.Worksheets.count If InStr(1, wb.Worksheets(i).name, rngCurrent.Value) <> 0 Then counter = counter + 1 '<--| update counter ws(counter) = wb.Worksheets(i).name End If Next