CODEWITHSUNDEEP
excelvba
Adrian
Adrian

Reputation: 691

Split Excel sheets to multiple Workbooks

I have an Excel file with multiple Sheets. I would like to split it into separate files, with 3 sheets per file.

I created a new WorkBook as follows:

Set NewBook = Workbooks.Add
With NewBook
     .Title = "File1"
     .Subject = "File1"
     .SaveAs FileName:="File1.xls"
End With

How can I copy sheets from one to another?

Upvotes: 1

Views: 5237

Answers (2)

brettdj
brettdj

Reputation: 55682

This code will

  • split you workbook into new workbooks of batches of 3 sheets at a time,
  • save them as new files with the naming below
  • close them

File1 (first 3 sheets)
File4 (sheets 4-6)
File7 (sheets 7-9)

The code will "pad" out the Excel file with extra sheets to keep to the 3 sheet split mutiple.

Note that you can create a new Workbook using .Copy - no need to use Workbooks.Add

Code to be run from the Workbook to be split

Sub BatchThree()
    Dim lngSht As Long
    Dim lngShtAdd As Long
    Dim lngShts As Long
    Dim bSht As Boolean
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    lngSht = 1

    'pad extra sheets
    If ThisWorkbook.Sheets.Count Mod 3 <> 0 Then
        bSht = True
        lngShts = ThisWorkbook.Sheets.Count Mod 3
        For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(Sheets.Count)
        Next
    End If

    Do While lngSht + 2 <= ThisWorkbook.Sheets.Count
        Sheets(Array(lngSht, lngSht + 1, lngSht + 2)).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "/File" & lngSht
        ActiveWorkbook.Close False
        lngSht = lngSht + 3
    Loop

    'remove extra sheets
    If bSht Then
     For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets(Sheets.Count).Delete
        Next
    End If

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

Upvotes: 2

Trace
Trace

Reputation: 18869

The base syntax to make a copy (if that is your question): 

Sub Make_Copy()
Thisworkbook.Sheets(1).Copy _
   after:=SomeWorkbook.Sheets(1)
End Sub

Next to copy, naturally you can also move sheets. You can copy before instead of after and change the name of the sheet.

Upvotes: 0

Related Questions