I have a userform with 2 checkboxes, when the user clicks on the send button it should copy the sheet 1 from currentWorkbook to a new workbook. If the user clicks in one of checkboxes (1 or 2) it works but if I clicks on the 2 checkboxes at the same time it doesn't work.

My goal is if the user clicks on the 2 checkboxes, it copies the sheet 1 from currentWorkbook to 2 new workbooks.

Any help is highly appreciated.

Private Sub CommandButton1_Click()

Dim theNewWorkbook As Workbook
Dim currentWorkbook As Workbook
Dim sFileSaveName As Variant
Dim industry As String
Dim dttoday As String

Set currentWorkbook = Workbooks("blabla" & ".xlsm")
Set theNewWorkbook = Workbooks.Add
currentWorkbook.Sheets("Sheet1").Activate

If one= True Then
currentWorkbook.Worksheets("Sheet1").Copy before:=theNewWorkbook.Sheets(1)
    With ActiveSheet
        .ListObjects(1).Name = "one"
    End With
ActiveSheet.ListObjects("one").Range.AutoFilter Field:=1, Criteria1:= _
        Array("bla", "ble", "bli", "blo"), _
        Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

'Save File

industry = "one "
dttoday = VBA.format(Now(), "ddmmyyyy")
saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
If sFileSaveName <> "False" Then ActiveWorkbook.SaveAs sFileSaveName
theNewWorkbook.Close

End If

If two = True Then
currentWorkbook.Worksheets("Sheet1").Copy before:=theNewWorkbook.Sheets(1)
    With ActiveSheet
        .ListObjects(1).Name = "two"
    End With
ActiveSheet.ListObjects("two").Range.AutoFilter Field:=1, Criteria1:= _
        Array("bla", "ble", "bli"), _
        Operator:=xlFilterValues
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

'Save File

industry = "two "
dttoday = VBA.format(Now(), "ddmmyyyy")
saveLocation = "C:\blabla_" & industry & dttoday & ".xlsx"
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
If sFileSaveName <> "False" Then ActiveWorkbook.SaveAs sFileSaveName
End If
Unload Me
End Sub

CodePudding user response：

This code should do the following:

• If checkbox one is checked create a new workbook with a copy of Sheet1 from the current workbook in it and name the table on the copied sheet 'one'.

• If checkbox two is checked create a new workbook with a copy Sheet1 from the current workbook in it and name the table on the copied sheet 'two'.

• Do both if both checkboxes are checked.

Option Explicit

Private Sub CommandButton1_Click()
Dim theNewWorkbook As Workbook
Dim currentWorkbook As Workbook
Dim sFileSaveName As Variant
Dim industry As String
Dim dttoday As String

    Set currentWorkbook = Workbooks("blabla" & ".xlsm")

    If one = True Then
        currentWorkbook.Worksheets("Sheet1").Copy
        Set theNewWorkbook = ActiveWorkbook
        With theNewWorkbook
            With .ActiveSheet
                .ListObjects(1).Name = "one"
                .ListObjects("one").Range.AutoFilter Field:=1, Criteria1:= _
                                                     Array("bla", "ble", "bli"), _
                                                     Operator:=xlFilterValues
                .Range(.Rows("2:2"), .Rows("2:2").End(xlDown)).Delete
                .ShowAllData
            End With


            'Save File

            industry = "one "
            dttoday = Format(Now(), "ddmmyyyy")
            saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
            sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
            If sFileSaveName <> "False" Then
                .SaveAs sFileSaveName
            End If
            .Close
        End With
    End If

    If two = True Then
        currentWorkbook.Worksheets("Sheet1").Copy
        Set theNewWorkbook = ActiveWorkbook
        With theNewWorkbook
            With .ActiveSheet
                .ListObjects(1).Name = "two"
                .ListObjects("two").Range.AutoFilter Field:=1, Criteria1:= _
                                                     Array("bla", "ble", "bli", "blo"), _
                                                     Operator:=xlFilterValues
                .Range(.Rows("2:2"), .Rows("2:2").End(xlDown)).Delete
                .ShowAllData
            End With


            'Save File

            industry = "two "
            dttoday = Format(Now(), "ddmmyyyy")
            saveLocation = "C:\blabla" & industry & dttoday & ".xlsx"
            sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=saveLocation, fileFilter:="Excel Files (*.xlsx), *.xlsx")
            If sFileSaveName <> "False" Then
                .SaveAs sFileSaveName
            End If
            .Close
        End With
    End If
    
    Unload Me
    
End Sub