複製動態數組導致下標超出範圍錯誤

Question

我試圖將工作表從主工作簿複製到目標工作簿，但根據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

完成並測試例如

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