FILL array

i have this piece of code:

Code:

---

With Sourcewb
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        .Sheets(Array("ReadMe", "MailSheet(s)")).Copy
    End With

---

instead to fill the array with a fixed name of sheet i need to fill the array with all sheets into work book but exclude "sheet1" and "sheet7".

Moved To Office Development

Code:

---

Sub Sample()
    Dim sheetNames As String, sheetCount As Long

    sheetCount = ThisWorkbook.Sheets.Count

    If sheetCount = 1 Then
        MsgBox "This workbook has only 1 Sheet"
        Exit Sub
    End If

    For i = 1 To sheetCount
        Select Case i
        Case 1, 7
        Case 2
            sheetNames = """" & Sheets(i).Name
        Case Else
            sheetNames = sheetNames & """" & "," & """" & Sheets(i).Name
        End Select
    Next
   
    sheetNames = sheetNames & """"
   
    '~~> Then you can change the below
    '.Sheets(Array("ReadMe", "MailSheet(s)")).Copy
   
    '~~>To
    '.Sheets(Array(sheetNames)).Copy
End Sub

---

That's won't work because Array(sheetNames) has only one element of a combined sheet names.
That must be an array of one or more elements with each element is a sheet name.

Try this: (replace ThisWorkbook with Sourcewb if required.)

Code:

---

Sub CopySheets()
    Dim sh        As Object
    Dim sNameStr  As String
    Dim arShName() As String
   
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Sheet1" And sh.Name <> "Sheet7" Then
            sNameStr = sNameStr & "/" & sh.Name
        End If
    Next
    If sNameStr <> "" Then
        sNameStr = Mid$(sNameStr, 2) '-- remove leading "/"
        arShName = Split(sNameStr, "/") '-- build array
        ThisWorkbook.Sheets(arShName).Copy
    End If
End Sub

---

Another way to build the array:

Code:

---

Sub CopySheets2()
    Dim sh        As Object
    Dim arShName() As String
    Dim i          As Long
   
    ReDim arShName(1 To ThisWorkbook.Sheets.Count)
    i = 0
    For Each sh In ThisWorkbook.Sheets
        Select Case sh.Name
            Case "Sheet1", "Sheet7"
            Case Else
                i = i + 1
                arShName(i) = sh.Name
        End Select
    Next
    If i > 0 Then
        ReDim Preserve arShName(1 To i)
        ThisWorkbook.Sheets(arShName).Copy
    End If
End Sub

---