Using VBA to create a new workbook from a work template

[SidWallace]

Hi

I am not too good with VBA. I have a template that has a summary and a number of tabs that are required to be completed based on what is marked in the summary. From the summary i would like to create a new workbook that only has the relevant sheets.

i.e. My Summary would have in column A the name of the sheets and B if they are relevant for this bit of work this is based off a data file that is saved in the workbook. All sheets would be set up in the workbook. In the new workbook all that is required to be created is the Summary, the data file and the relevant sheets that have a Y in column B. In the example below I would only require sheets for the Summary, the data file and SheetA, SheetC and SheetE.

Is this possible?

A	Y
B	N
C	Y
D	N
E	Y

<COLGROUP><COL style="WIDTH: 62pt; mso-width-source: userset; mso-width-alt: 2624" width=82><COL style="WIDTH: 54pt" width=72><TBODY>
</TBODY>

 

[Comfy]

If you include the Summary Sheet and Data sheet names in your table:

Excel 2010

	A	B
1	Sheet	Required
2	Summary	y
3	Data	y
4	Sheet3	n
5	Sheet4	y
6	Sheet5	n
7	Sheet6	y

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Summary​

Could can do something like the following:

Sub CreateWorkbook()


Dim rng As Range
Dim i As Long
Dim SheetsArr() As String
Dim SheetCount As Long
Dim wb As Workbook


Set rng = ActiveWorkbook.Sheets("Summary").UsedRange
SheetCount = 1


For i = 2 To rng.Rows.Count
    If Contains(Sheets, rng.Cells(i, 1)) And LCase(rng.Cells(i, 2).Value) = "y" Then
        ReDim Preserve SheetsArr(1 To SheetCount)
        SheetsArr(SheetCount) = rng.Cells(i, 1)
        SheetCount = SheetCount + 1
    Else
    'What would you like to do if a sheet marked as y doesnt exist?
    End If
Next i


ActiveWorkbook.Sheets(SheetsArr).Copy
Set wb = ActiveWorkbook


'The rest of your code to manipulate the new workbook goes here


End Sub
Function Contains(objCollection As Object, strName As String) As Boolean
    Dim o As Object
    On Error Resume Next
    Set o = objCollection(strName)
    Contains = (Err.Number = 0)
 End Function

 

[SidWallace]

Thanks Comfy just what i needed.