Solved

Excel VBA Save Sheets in Excel file as separate Excel Files

Posted on 2016-11-17
5
84 Views
Last Modified: 2016-11-17
Hi

I need to loop through all the sheets in my Excel file and if the sheet has a numeric name eg (1, 2 etc) then I want to save that sheet as a new separate file. I have the following code so far but am getting the error "Object Required" on the line      xWs.Copy

Sub oSave_Individual_Numeric_Sheets_As_Files()

Dim oDate As String
Dim oHole As String

On errot GoTo EH

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Integer
Dim oSheetName As String
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Dim xWs As Worksheet


    For i = 1 To Sheets.Count
   
        For Each xWs In ThisWorkbook.Sheets
            oSheetName = xWs.Name
            If IsNumeric(oSheetName) = True Then
                 
                oDate = xWs.Range("D4").Value
                oHole = xWs.Range("D5").Value
                xWs.Copy 'Get Error here "Object Required"
                Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & oDate & " " & oHole & ".xls"
                Application.ActiveWorkbook.Close False
            End If
        Next
       
    Next i
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

Exit Sub
EH:
    MsgBox Err.Description & " eh55"
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
End Sub
0
Comment
Question by:murbro
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 41891504
Remove the  For i = 1 To Sheets.Count loop.
0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 41891511
Try changing:

For Each xWs In ThisWorkbook.Sheets

to

For Each xWs In ActiveWorkbook.Sheets

Thanks
Rob
0
 
LVL 33

Assisted Solution

by:Rob Henson
Rob Henson earned 250 total points
ID: 41891523
And, the xWs.Copy is not specifying which sheet to copy, try:

Sheets(oSheetName).Copy

As MacroShadow says, remove the For I = 1 to Sheets.Count loop.  This is counting the number of sheets and then the routine below is going through all sheets that number of times. So if you have 10 sheets, it is copying each sheet 10 times and overwriting the previous copy each time.
0
 
LVL 81

Accepted Solution

by:
byundt earned 250 total points
ID: 41892456
You may encounter an error saying that the file type doesn't match the extension when you try to open a file saved by this macro. The cure for this is to specify the FileFormat property when you save the file. You didn't need to do this with Excel 2003 and earlier--but you do with Excel 2007 and later.

If your workbook contains a chart sheet with a numeric name, then that will cause a runtime error if you are looping through ActiveWorkbook.Sheets. The workaround is to loop through ActiveWorkbook.Worksheets instead.

I also removed the statements turning screen updating back on. These statements are not necessary, and will slow execution down (and cause a flicker), because Excel VBA does the same thing for you automatically when it finishes executing a macro.

Finally, I incorporated the changes regarding looping as suggested by MacroShadow & Rob Henson.
Sub oSave_Individual_Numeric_Sheets_As_Files()

Dim oDate As String
Dim oHole As String
Dim oSheetName As String
Dim xPath As String
Dim xWs As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo EH
xPath = ActiveWorkbook.Path

    For Each xWs In ActiveWorkbook.Worksheets
        oSheetName = xWs.Name
        If IsNumeric(oSheetName) = True Then
             
            oDate = xWs.Range("D4").Value
            oHole = xWs.Range("D5").Value
            xWs.Copy 'Get Error here "Object Required"
            ActiveWorkbook.SaveAs Filename:=xPath & "\" & oDate & " " & oHole & ".xls", FileFormat:=56
            ActiveWorkbook.Close False
        End If
    Next
   
    Application.DisplayAlerts = True

    Exit Sub

EH:
    MsgBox Err.Description & " eh55"
   
    Application.DisplayAlerts = True
   
End Sub

Open in new window

0
 

Author Closing Comment

by:murbro
ID: 41892529
Thanks very much
0

Featured Post

MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Use Windows Task Scheduler to print a Word document weekly so your printer ink won't dry out.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question