Excel 2003 VBA: Move a sheet into a new workbook that is referenced by a variable

18,656

Solution 1

Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook   

For Each s In ThisWorkbook.Sheets
    If s.Name <> "Data" Then
        ''Added by Soldieraman
        Dim sheetName As String
        sheetName = s.Name

        Set newWb = Workbooks.Add
        s.Move before:=newWb.Sheets(1)
        Application.DisplayAlerts = False
        newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
        Application.DisplayAlerts = True

        ''Edited by soldieraman
        newWb.SaveAs Filename:="C:\Export\Test" & sheetName & ".xls"
        newWb.Close
    End If
Next s
End Sub

Solution 2

Although this is old, and the accepted answer by soldieraman is very nice, just wanted to add one thing. The Excel VBA Sheets.Copy and Sheets.Move methods have a very nice feature. They take either of two optional arguments, "Before" or "After", to position a moved/copied sheet. The Excel documentation notes that:

 If you don't specify either Before or After, Microsoft Excel
 creates a new workbook that contains the moved [copied] sheet.

So, it is almost surprising, but you can just say:

 Sheets(sheetname).Move

in the accepted answer, in place of:

 Set newWb = Workbooks.Add
 s.Move before:=newWb.Sheets(1)
 Application.DisplayAlerts = False
 newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
 Application.DisplayAlerts = True

The rest of soldieraman's code would work fine with this simplification.

Share:
18,656
Margaret
Author by

Margaret

Updated on June 13, 2022

Comments

  • Margaret
    Margaret almost 2 years

    I have a function that is meant to run the ShowPages() command of a PivotTable and then save each sheet to a separate file.

    Here's how I wish I could do it:

    Sub Split()
        ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
        Dim newWb As Workbook
    
        For Each s In ThisWorkbook.Sheets
            If s.Name <> "Data" Then
                Set newWb = s.Move #This is the line I'm trying to work out
                newWb.SaveAs Filename:="C:\Export\" + s.Name + ".xls"
                newWb.Close
            End If
        Next s
    
    End Sub
    

    Unfortunately, this is running into a bunch of issues to do with not having created objects and suchlike (understandably). What is the most sensible way to do this?