Link to home
Start Free TrialLog in
Avatar of W.E.B
W.E.B

asked on

VBA Save workbook

Hello,
Can you please help,
I'm using below to save my workbook,
I need to be able to exclude few sheets from being saved.
Also,
I need to remove the Macro buttons from the newly saved Workbook.

    Dim mySheetList() As String
    Dim strFileName1 As String
    strFileName1 = Range("P1").Value & ".xlsx"
   
    ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
    Dim a As Integer
    a = 0
    For Each ws In ActiveWorkbook.Worksheets
        mySheetList(a) = ws.Name
        a = a + 1
    Next ws
    Worksheets(mySheetList).Copy
    ActiveWorkbook.SaveAs Filename:=  "C:\Users\Wassim\Desktop\" & strFileName1, FileFormat:=51, CreateBackup:=False

Any help is appreciated.
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Suppose you want to exclude Sheets named as "Sheet1", "Sheet2" and "Sheet3" from SaveAs statement, you may try something like this......
Dim mySheetList() As String
Dim strFileName1 As String
Dim ws As Worksheet
    strFileName1 = Range("P1").Value & ".xlsx"
   
    ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
    Dim a As Integer
    a = 0
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" Then
            mySheetList(a) = ws.Name
            a = a + 1
            Worksheets(mySheetList).Copy
            ActiveWorkbook.SaveAs Filename:="C:\Users\Wassim\Desktop\" & strFileName1, FileFormat:=51, CreateBackup:=False
        End If
    Next ws

Open in new window


As far as removing the button is concerned, what type of button it is? Is it an ActiveX Commanbutton or Form Control Commandbutton or just a Shpae which is assigned to a macro?
Avatar of W.E.B
W.E.B

ASKER

Hello,
Thank you for your help,
I'm getting error message

RunTime error 9, Subscript out of range.
Worksheets(mySheetList).Copy

The botton a a form Form Control Commandbutton

thank you,
RunTime error 9, Subscript out of range simply means that there is no mySheetList worksheet in your workbook.

While you get the error message debug it and hover your mouse over mySheetList and see what value it contains and then check whether that worksheet exists in your workbook or not.
Okay try this to see if this resolves your issue.
Dim mySheetList() As String
Dim strFileName1 As String
Dim ws As Worksheet
Dim shp As Shape
    strFileName1 = Range("P1").Value & ".xlsx"
   
    ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
    Dim a As Integer
    a = 0
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" Then
            mySheetList(a) = ws.Name
            Worksheets(mySheetList(a)).Copy
            a = a + 1
            ActiveWorkbook.SaveAs Filename:="C:\Users\Wassim\Desktop\" & strFileName1, FileFormat:=51, CreateBackup:=False
            With ActiveWorkbook.ActiveSheet
                For Each shp In .Shapes
                    shp.Delete
                Next
            End With
            ActiveWorkbook.Close True
        End If
    Next ws

Open in new window

Avatar of W.E.B

ASKER

Hello,
it is saving with no errors,
however, it is only saving the last sheet.
IE: I see it saving each sheet (80 sheets), but when all is done, only last sheet is the one saved.

thank you
Yes it will. Because of this line which you have declared before the loop saves the workbook with the same name each time and overwrites the previous one.

strFileName1 = Range("P1").Value & ".xlsx"

In other words in your SaveAs line of code value of strFileName1 doesn't change because as per your code strFileName1 takes the value of the cell P1 from the sheet which is active before the loop starts.
Avatar of W.E.B

ASKER

ok,  thanks,
how do I make it save all sheets except the specific one's
I am not sure that why you are using the array.
Try saving the workbook with the sheet names.

See if the following code works for you....
Dim strFileName1 As String
Dim ws As Worksheet
Dim shp As Shape
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" Then
            strFileName1 = ws.Name
            ws.Copy
            ActiveWorkbook.SaveAs Filename:="C:\Users\Wassim\Desktop\" & strFileName1, FileFormat:=51, CreateBackup:=False
            With ActiveWorkbook.ActiveSheet
                For Each shp In .Shapes
                    shp.Delete
                Next
            End With
            ActiveWorkbook.Close True
        End If
    Next ws

Open in new window

Avatar of W.E.B

ASKER

I get error
Run-Time Error 1004
Method Copy of object_Worksheet failed
Avatar of W.E.B

ASKER

Sorry,
my mistake, no error
but it is saving each sheet separate.
but it is saving each sheet separate.
Is it expected or unexpected?

It seems that you don't have an ideal about what your original code is supposed to do.
I am also not sure that what are you trying to achieve.
Avatar of W.E.B

ASKER

My original code is working .
not sure if you tried it....!!!

my question was,
I need to be able to exclude few sheets from being saved.
Also,
I need to remove the Macro buttons from the newly saved Workbook.

not sure if you understood the question before you answered.
Hmm. That's interesting.

If your original code was working perfectly, add the following line of code to exclude specific sheets from the code...

If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" Then

Open in new window

Here you can change the names of sheets as per your requirement, the above line was just to show you that how can you exclude few sheets. That's it.

Now your next question was how to delete the button from the new workbook. Add the following lines of code to achieve that...

With ActiveWorkbook.ActiveSheet
                For Each shp In .Shapes
                    shp.Delete
                Next
 End With

Open in new window


So you can see I hadn't changed anything in your original code but then you complained that you are getting RunTime error 9, then only I made some changes in your original code.

If your original code was working perfectly, make the above suggested changes in your original code and it should run without an issue.

I think without making any changes in your original code, I have answered all your queries.
Avatar of W.E.B

ASKER

Please see attached sample.
If I run Export-1, it saves a new workbook.

If I run Export-2, with this line added
 If ws.Name <> "All_Accounts" And ws.Name <> "Files" And ws.Name <> "Orders" Then

I get error.

I do appreciate the help.

if there is another code that is easier and will do the job, I'm ok to use.
Sample.xlsm
Didn't run the whole code but corrected the code in order to remove the runtime error.

You used IF statement before the looping through worksheet started. It should be like this......

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "All_Accounts" And ws.Name <> "Files" And ws.Name <> "Orders" Then
            mySheetList(a) = ws.Name
            a = a + 1
        End If
    Next ws

Open in new window

Also declare the variable ws like Dim ws As Worksheet as it is good practice to declare the variables used in the code.

Does this help?
Avatar of W.E.B

ASKER

RunTime error 9, Subscript out of range.

Worksheets(mySheetList).Copy
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of W.E.B

ASKER

Merci Beaucoup,
Thank you for your time and help.
This worked.
De rien.
Glad it worked for you. :)