Seprating workbook into multiple worksheets RRS feed

  • Question

  • My workbook contains 36 sheets and i want to seprate into 9 workbooks containing 4 sheets each like 1 to4 in one workbook then 5 to 8 in next workbook....and I want this to be in a seprate macro having a button to seprate. plaese provide the exact code

    Thursday, December 12, 2013 3:20 AM


  • Hi,

    This is the code that you need:

    Option Explicit

    Sub SeparateSheets()

    Dim Sheet As Worksheet
    Dim SheetsArray() As String
    Dim Temp As String
    Dim NumberOfSheets As Long
    Dim i As Long

    Application.ScreenUpdating = False

    Const MaxToTransfer As Long = 4 'maximum sheets to transfer

    ReDim SheetsArray(1 To 1)
    NumberOfSheets = 0

    For Each Sheet In ThisWorkbook.Sheets
        If NumberOfSheets = MaxToTransfer Then
            NumberOfSheets = 0
            ReDim SheetsArray(1 To 1)
        End If
        If Sheet.Name <> "Master" Then 'Must be in original workbook at least one visible sheet
            NumberOfSheets = NumberOfSheets + 1
            ReDim Preserve SheetsArray(1 To NumberOfSheets)
            SheetsArray(NumberOfSheets) = Sheet.Name
        End If
    Next Sheet

    'If number of sheets does not devided by MaxToTransfer (There is a remainder)


    Application.ScreenUpdating = True

    End Sub

    Guy Zommer

    Thursday, December 12, 2013 6:09 AM