在Excel VBA中将工作表名称添加到数组

Question

I am trying to add sheet names into an array in Excel VBA using the code below. It is only picking up one value (always the last worksheet name). For example, if I have 2 sheets: List1 and List2, it only picks up List2 and shows a blank value for the first sheet. If I add 4, it only shows the 4th, and so on. I'm not sure why I'm getting blank values.

Dim curSheet As Worksheet
Dim ArraySheets() As String
Dim x As Variant

For Each curSheet In ActiveWorkbook.Worksheets

    If curSheet.Name Like "*List*" Then

        ReDim ArraySheets(x)

        ArraySheets(x) = curSheet.Name

        x = x + 1

    End If

Next curSheet

Answer 1

You should change ReDim ArraySheets(x) to ReDim Preserve ArraySheets(x)

When you use just ReDim the contents of the array are not kept, which is why you only get the final sheet name. Using ReDim Preserve re-sizes the array while keeping the contents.

Answer 2

Without loops

Sub GetNAmes()
Dim strIn As String
Dim X

strIn = Application.InputBox("Search string", "Enter string to find", "*List*", , , , , 2)
If strIn = "False" Then Exit Sub

ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
X = Filter([index(shtNames,)], strIn, True, 1)

Select Case UBound(X)
    Case Is > 0
        strIn = Application.InputBox(Join(X, Chr(10)), "Multiple matches found - type position to select", , , , , 1)
        If strIn = "False" Then Exit Sub
        On Error Resume Next
        Sheets(CStr(X(strIn))).Activate
        On Error GoTo 0
    Case 0
        Sheets(X(0)).Activate
    Case Else
        MsgBox "No match"
End Select

End Sub