Copy Paste Value Macro/Save Individual File to right of specific tab.

csch123

New Member
Joined
Mar 6, 2013
Messages
32
Hello,

I have a current macro that saves each sheet as their own file. The first 10-15 sheets are not really necessary, so I typically delete them once the macro has run. I am looking to add two things to my current code:

1. Add a tab called Start. Make the macro look for 'Start' tab and then just save each sheet to the right of that as its own file.

2. Save each sheet in the macro as just a copy/paste value. They current have a lot of links and it makes each file close to 3MB. That makes it incredibily difficult to paste all in one email.

Here is the current code:

Sub CreateWorkbooks()
'Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False 'Don't show any screen movement
strSavePath = "H:\Finance\2013\Test\" 'This could be any folder you want. Make sure to add \ at the end.
Set wbSource = ActiveWorkbook
For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & sht.Name
wbDest.Close
Next
Application.ScreenUpdating = True
Exit Sub
ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub


Is this possible?

Thanks for any help!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Give this a try. Post back if there is a problem.
Code:
Sub CreateWorkbooks2()
'Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False 'Don't show any screen movement
strSavePath = "H:\Finance\2013\Test\" 'This could be any folder you want. Make sure to add \ at the end.
Set wbSource = ActiveWorkbook
sIdx = wbSource.Sheets("Start").Index
    For i = sIdx + 1 To wbSource.Sheets.Count
        Workbooks.Add
        Set wbDest = ActiveWorkbook
        wbSource.Sheets(i).UsedRange.Copy wbDest.Sheets(1).Range("A1")
        wbDest.Sheets(1).Name = wbSource.Sheets(i).Name
            With wbDest.Sheets(1).UsedRange
                .Value = .Value
            End With
        wbDest.SaveAs strSavePath & sht.Name
        wbDest.Close
    Next
Application.ScreenUpdating = True
Exit Sub
ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

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
Back
Top