add worksheet to group

R

Rich

I am looking for a way to add a worksheet to a group of
sheets that I will print using the "printpreview" method.

I will add them if they meet certain requirements, which
I've already worked out.

I'm just looking for the method and an example to add the
sheets to the group.
 
R

Ramses

Hi

Try this code.
Exclude the sheets who should not be selected with your code, and ad
them into the "non selectable" array:

Option Explicit

Sub Group_Selected_Sheets_in_Array_for_Printout()
'by Ramses
'Define Worksheets for a group
Dim vWorksheet As Worksheet
Dim vWorksheetsToSelect() As String
Dim vWorksheetsToDeselect(2) As String
Dim i As Byte
Dim ii As Byte
Dim vFound As Boolean
'Define Sheet who should not selected into group
vWorksheetsToDeselect(0) = "Sheets1"
vWorksheetsToDeselect(1) = "Sheets2"
vWorksheetsToDeselect(2) = "Sheets3"
ii = 0
'All other Sheets will be selected
For Each vWorksheet In Worksheets
vFound = False
For i = 0 To UBound(vWorksheetsToDeselect)
If vWorksheet.Name = vWorksheetsToDeselect(i) Then
vFound = True
Exit For
End If
Next i
If Not vFound Then
ReDim Preserve vWorksheetsToSelect(ii)
vWorksheetsToSelect(ii) = vWorksheet.Name
ii = ii + 1
End If
Next vWorksheet
'Select Sheets in Array
Sheets(vWorksheetsToSelect).Select
End Sub

If you have more than 255 sheets in your workbook, change Type of i an
ii from Byte into Integer ;-)

Best regards from switzerland :-
 
B

Bob Phillips

Hi Rich,

Here is some sample code to group the sheets, just change the criteria to
yours

Dim i As Long, j As Long
Dim arySheets

For i = 1 To Worksheets.Count
If Left(Worksheets(i).Name, 5) = "Sheet" Then
If j = 0 Then
ReDim arySheets(0)
Else
ReDim Preserve arySheets(j)
End If
arySheets(j) = Worksheets(i).Name
j = j + 1
End If
Next i

Worksheets(arySheets).Select

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
B

Bob Phillips

Thank you, and it is a pleasure.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Top