Synax help/ worksheet array

[KT]

I am creating an array of worksheets that needs to exclude certain
worksheets. I’ve adapted the following from code Per provided to add each
sheet to my array, but now I need to move my entire sheet array to a new
workbook. How do I refer to the entire array? Thanks!

Sub arrSh()
Dim shArr() As Worksheet
Dim shCount As Long
Dim sh As Variant

For Each sh In ThisWorkbook.Sheets

Select Case sh.Name
Case "excludeTHISsheet", "excludeTHATsheet"
'do nothing
Case Else
shCount = shCount + 1
ReDim Preserve shArr(1 To shCount)
Set shArr(shCount) = sh
End Select

Next

For sh = 1 To UBound(shArr)
Debug.Print shArr(sh).Name
Next

Worksheets(shArr).Move '<< THIS IS THE PROBLEM LINE. NEED SYNTAX TO MOVE ALL
SHEETS IN ARRAY TO NEW WB

End Sub

 

[Dave Peterson]

I'd just create an array of strings (sheet names) and use that:

Option Explicit
Sub MoveSomeSheets()

Dim shArr() As String 'not worksheets
Dim shCount As Long
Dim sh As Object 'just a little better than Variant here
Dim TempWks As Worksheet

With ThisWorkbook
'make sure that there's at least one sheet that won't be moved
'so the workbook won't close after the move
Set TempWks = .Worksheets.Add
TempWks.Name = "DummyStr" & Format(Now, "yyyymmddhhmmss")

ReDim shArr(1 To .Sheets.Count)
shCount = 0
For Each sh In ThisWorkbook.Sheets
Select Case LCase(sh.Name)
Case Is = LCase("excludeTHISsheet"), _
LCase("excludeTHATsheet"), _
LCase(TempWks.Name)
'do nothing
Case Else
shCount = shCount + 1
shArr(shCount) = sh.Name
End Select
Next sh

If shCount = 0 Then
MsgBox "nothing to move"
Else
ReDim Preserve shArr(1 To shCount)
Sheets(shArr).Move
End If

'some clean up
If .Sheets.Count > 1 Then
Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True
Else
MsgBox "Couldn't delete " & TempWks.Name
End If
End With

End Sub

====
Actually, if you had any hidden sheets, you'd want to add some validity.
(Checking ".sheets.count > 1" isn't enough.)

 

[KT]

Perfect. Thanks Dave!
--
KT

I'd just create an array of strings (sheet names) and use that:

Option Explicit
Sub MoveSomeSheets()

Dim shArr() As String 'not worksheets
Dim shCount As Long
Dim sh As Object 'just a little better than Variant here
Dim TempWks As Worksheet

With ThisWorkbook
'make sure that there's at least one sheet that won't be moved
'so the workbook won't close after the move
Set TempWks = .Worksheets.Add
TempWks.Name = "DummyStr" & Format(Now, "yyyymmddhhmmss")

ReDim shArr(1 To .Sheets.Count)
shCount = 0
For Each sh In ThisWorkbook.Sheets
Select Case LCase(sh.Name)
Case Is = LCase("excludeTHISsheet"), _
LCase("excludeTHATsheet"), _
LCase(TempWks.Name)
'do nothing
Case Else
shCount = shCount + 1
shArr(shCount) = sh.Name
End Select
Next sh

If shCount = 0 Then
MsgBox "nothing to move"
Else
ReDim Preserve shArr(1 To shCount)
Sheets(shArr).Move
End If

'some clean up
If .Sheets.Count > 1 Then
Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True
Else
MsgBox "Couldn't delete " & TempWks.Name
End If
End With

End Sub

====
Actually, if you had any hidden sheets, you'd want to add some validity.
(Checking ".sheets.count > 1" isn't enough.)