VBA to Move Named Sheets to New Workbook & Save

kabijenn

New Member
Joined
Jul 23, 2018
Messages
7
Hello Experts! I have a massive Excel file that I need to take specific worksheets (that have tables) to a new workbook, save as the tab name. I want to be able to specify which worksheets (that may, or may not be visible) that I want to have the code move/save. I have found two examples of code (pasted below) and I was trying to merge them and it just wasn't working. Can anyone PLEASE help?!! Thank you!!!

This code unhides the worksheets given a specific name:
'Set tab naming convention to hide & unhide
Const TABNAME As String = "1218"

Sub Unhide_Named_Sheets()
'Unhide all sheets that end with -h
Dim ws As Object 'Use object instead of worksheet for Chartsheets
'Unhide sheets with sheet name ending in -h
For Each ws In ActiveWorkbook.Sheets
If Right(ws.Name, 4) = TABNAME Then
ws.Visible = xlSheetVisible
End If
Next ws
End Sub

This code creates a folder & moves all worksheets (which is the problem, I want only those that I specify, so for example, only those worksheets that end in 1218) to a new workbook, saves the workbook as the tab name.

Option Explicit

Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
Could you have a saveas macro for the original sheet as the tabname, then delete the worksheets you don't want?
 

kabijenn

New Member
Joined
Jul 23, 2018
Messages
7
Hi Dave - I'm not sure I understand your question. If the macro moves & saves the worksheets, I won't need to delete the originals. Or are you suggesting a macro that takes the named worksheets and copies instead of moves and then I delete the original? If that's the case, absolutely. My biggest time saver that I need is having a macro that either copies or moves the worksheets based off of the last 4 digits of the tabname & saves using the tabname. I can delete the originals no problem. Thanks!!
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
I'm saying ,use a macro to just rename the workbook and delete the worksheets you don't want
 

kabijenn

New Member
Joined
Jul 23, 2018
Messages
7

ADVERTISEMENT

Oh no, I can't do that, each individual sheet represents a customers data for a given month and then I have a "master sheet" that has all sorts of formulas to convert each tab of the customers data to a specific format so that the master sheet can used to feed a SQL table (which I need to keep some in the workbook as the data can change in a given quarter). The workbook itself has gotten so massive that it locks up on me. So I have been hardcoding the older rows and then moving the corresponding tabs to new workbooks so that I can save what the customer's data was for that given month, but also make my workbook smaller and easier to work with. I inherited this so I'm slowly trying to make improvements on it. Right now I am trying to move/save the 2016-2018 tabs & the first half of 2019 tabs just so I can work in the workbook. Next year I will revamp the entire process so that the individual tabs will just go directly into SQL and I won't need this "master sheet" at all. I'm just not there yet.
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
Okay,
You can make an array of sheets and turn them into a new workbook.
Test it out.
VBA Code:
Sub MakeArraySheets()
    Dim sh As Worksheet
    Dim ArraySheets() As String
    Dim x As Variant

    For Each sh In ActiveWorkbook.Worksheets
        If InStr(sh.Name, 2018) <> 0 Then
            ReDim Preserve ArraySheets(x)
            ArraySheets(x) = sh.Name
            x = x + 1
        End If
    Next sh

    Sheets(ArraySheets).Copy    'change to move if you want to move the sheets

    MsgBox "Your saveas code goes here"

End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,523
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi,
you could add a parameter to your code & pass the sheet names you want to copy

See if this update to your code do es what you want

VBA Code:
Sub SaveShtsAsBook(ParamArray SheetNames() As Variant)
        Dim SheetName As String, MyFilePath As String
        Dim CopySheets As Variant
        Dim wb As Workbook
        Dim ws As Worksheet
        
        CopySheets = SheetNames
        
        MyFilePath = ActiveWorkbook.Path & "\" & _
                      Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'<< a folder exists
        On Error Resume Next
'<< create a folder
        MkDir MyFilePath
        On Error GoTo 0
        
        Application.ScreenUpdating = False
        For Each ws In ThisWorkbook.Worksheets
            If Not IsError(Application.Match(ws.Name, CopySheets, 0)) Then
            SheetName = ws.Name
            ws.UsedRange.Copy
            Set wb = Workbooks.Add(xlWBATWorksheet)
            With wb
                With .Sheets(1)
                    .Paste
                    .Name = SheetName
                End With
'save book in this folder
                .SaveAs Filename:=MyFilePath & "\" & SheetName & ".xls", FileFormat:=56
                .Close False
            End With
            End If
            Application.CutCopyMode = False
            Set wb = Nothing
        Next
     Sheet1.Activate
    Application.ScreenUpdating = True
End Sub

to call, just list all sheet names you want to be copied.

VBA Code:
SaveShtsAsBook "Sheet2", "Sheet4", "Sheet6"

Dave
 

kabijenn

New Member
Joined
Jul 23, 2018
Messages
7
Hi,
you could add a parameter to your code & pass the sheet names you want to copy

See if this update to your code do es what you want

VBA Code:
Sub SaveShtsAsBook(ParamArray SheetNames() As Variant)
        Dim SheetName As String, MyFilePath As String
        Dim CopySheets As Variant
        Dim wb As Workbook
        Dim ws As Worksheet
       
        CopySheets = SheetNames
       
        MyFilePath = ActiveWorkbook.Path & "\" & _
                      Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'<< a folder exists
        On Error Resume Next
'<< create a folder
        MkDir MyFilePath
        On Error GoTo 0
       
        Application.ScreenUpdating = False
        For Each ws In ThisWorkbook.Worksheets
            If Not IsError(Application.Match(ws.Name, CopySheets, 0)) Then
            SheetName = ws.Name
            ws.UsedRange.Copy
            Set wb = Workbooks.Add(xlWBATWorksheet)
            With wb
                With .Sheets(1)
                    .Paste
                    .Name = SheetName
                End With
'save book in this folder
                .SaveAs Filename:=MyFilePath & "\" & SheetName & ".xls", FileFormat:=56
                .Close False
            End With
            End If
            Application.CutCopyMode = False
            Set wb = Nothing
        Next
     Sheet1.Activate
    Application.ScreenUpdating = True
End Sub

to call, just list all sheet names you want to be copied.

VBA Code:
SaveShtsAsBook "Sheet2", "Sheet4", "Sheet6"

Dave

Thanks Dave! I can't get this to work (admittedly I am new to VBA so please excuse my ignorance)...but from what I can gather from reading this, I would have to specifically name each sheet that I want to move/save. Every customer in this workbook would have a sheet for each month, for example, "Customer A_1218", so I want to say all sheets ending in "1218" would be moved and each saved in their own workbook.
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,089
FYI, there are two Daves on this thread
Actually, it just looks for 2018 in the sheet name and places it in the sheet array, but you could change the parameters to,
VBA Code:
If right(sh.Name,4) = 2018 Then
 

kabijenn

New Member
Joined
Jul 23, 2018
Messages
7
You are right, my apologies on the multiple Dave's. I just tried what you sent, updating it to Move and it worked perfectly. However, I do not know how to add the piece where it automatically saves the new workbook as the tabname? Location is irrelevant, can be the same location as the 'master workbook'. Can you help me add that piece? Again, thank you for your patience and assistance!!
 

Watch MrExcel Video

Forum statistics

Threads
1,130,167
Messages
5,640,534
Members
417,151
Latest member
ChickenTenderer

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top