FILL array

[luca90]

i have this piece of 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".

[Hack]

Moved To Office Development

[Siddharth Rout]

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

[anhn]

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.)

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:

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