mercredi 23 mars 2022

add multiple workbooks using checkboxes

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



Aucun commentaire:

Enregistrer un commentaire