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

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

2 个答案: