简体   繁体   中英

Save Worksheets to new Workbook By Checkbox [Excel Macro/VBA]

So my main goal is to save sheets (depending on if they are selected by a checkbox) to a new workbook.

Here is my code:

Sub saveSheetWorkbook()

Dim exampleName As Variant
Dim exampleSavePath As String
Dim exampleSheet As Variant

exampleName = InputBox("Who will this be sent to?")

exampleSavePath = ActiveWorkbook.Path & "\" & exampleName

If Worksheets("Example Worksheet 1").Range("E29") = True Then
exampleSheet = "Example Worksheet 2"
End If

Sheets(Array("Example Worksheet 1"), exampleSheet).Copy
ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

For example, I want to always save Example Worksheet 1, but only save Example Worksheet 2 if the checkbox is ticked. The cell E29 in Example Worksheet 1 is the linked cell for the checkbox.

So this macro works when the checkbox is ticked, but when the checkbox is unticked, I get an error.

I have set it up so that the sheet array either contains the name or nothing. but when containing nothing, that gives me the error.

Any help would be great.

Edit: I need this for 6 different checkboxes/sheets.

you have one parenthesis too much

then

Sub saveSheetWorkbook()

    Dim exampleName As Variant
    Dim exampleSavePath As String
    Dim sheetsArray As Variant

    exampleName = InputBox("Who will this be sent to?")

    exampleSavePath = ActiveWorkbook.Path & "\" & exampleName

    If Worksheets("Example Worksheet 1").Range("E29") Then
        sheetsArray = Array("Example Worksheet 1", "Example Worksheet 2")
    Else
        sheetsArray = Array("Example Worksheet 1")
    End If

    Sheets(sheetsArray).Copy
    ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

You can use my example workbook to do this with form: https://drive.google.com/open?id=0BzFv0oeets6ubHg2bk96SHotdkU

To create this by yourself, here is instructions:

  1. Press ALT+F11 in order to open VBA window;
  2. Create userform with name "Userform1"
  3. Put listbox to form and change its name to "lstSheet"
  4. Change its properties like shown below:
    • ListStyle: 1-fmListStyleOPtion;
    • MultiSelect: 1-fmMultiSelectMulti;

Userform code:

Option Explicit
Dim NewName As String
Dim ws As Worksheet
Dim NumSheets As Integer


Private Sub CommandButton1_Click()
Dim Count As Integer, i As Integer, j As Integer
Count = 0
For i = 0 To lstSheet.ListCount - 1
    'check if the row is selected and add to count
    If lstSheet.Selected(i) Then Count = Count + 1
Next i
For i = 0 To lstSheet.ListCount - 1
    If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Select True

Next i


For i = 0 To lstSheet.ListCount - 1
If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Select False
If lstSheet.Selected(i) Then Sheets(lstSheet.List(i)).Activate
Next i
Unload Me
ActiveWindow.SelectedSheets.Copy

For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

         '       Remove named ranges

         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"

        ActiveWorkbook.Close SaveChanges:=False

      Application.ScreenUpdating = True
End Sub

Private Sub lstSheet_Click()

End Sub

Private Sub UserForm_Initialize()
Dim Sh As Variant
    'for each loop the add visible sheets
    For Each Sh In ActiveWorkbook.Sheets
        'only visible sheetand exclude login sheet
        If Sh.Visible = True Then
            'add sheets to the listbox
            Me.lstSheet.AddItem Sh.Name
        End If
    Next Sh
End Sub
  1. Create Module and put this code there:

Sub showForm()
  Userform1.Show
End Sub 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM