VBA Code assigned to CommandButton

[mio306]

In three sheets I have a button CommandButton_Click(). I wrote, in all three sheets, this code and I assigned at all the three buttons. Pressed the button that copies the active sheet a new wrokbook.

Private Sub CommandButtonSave_Click ()
...
...
ActiveSheet.Copy
With ActiveSheet.UsedRange
. Copy
. PasteSpecial xlValues
. PasteSpecial xlFormats
End With
ActiveSheet.Shapes (CommandButton1). Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName: = NewName, FileFormat: = xlWorkbookNormal
Application.DisplayAlerts = True
ActiveWindow.Close
.....
.....
End Sub
The solution I do not like it because:
1. Same code is replicated three times , written in the Sheet1, Sheet2 and Sheet3. I would write it in one place.
2. In the couple of the sheet, the macro deletes the CommandButton, but the code remains in the VBA project . I would like to have the new worbook without VBA code.
I tried to solve the problem by writing code in ThisWorbook, but I do not know how to assign it to any one of the buttons CommandButton_Click (), in three different sheet.
Someone could help to solve this problem? Thanks in advance.
Mio

[Rob342]

Hi mio,

Dont quite understand what you are trying to do, do you want to save 1 sheet only or all of the workbook.
This routine will save a copy of the workbook, but you can modify to save only 1 sheet if you want.

This code goes on 1 sheet only
Create command button on this sheet


Option Explicit
Private Sub CommandButton1_Click()
Call Module1.CommandButton1_Click
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Quit
ThisWorkbook.Close (False)
End Sub


Then in a standard module eg 1


Option Explicit
Sub CommandButton1_Click()
Dim wkscmdBttn As OLEObjects
Application.ScreenUpdating = False
Application.EnableEvents = False
Worksheets(1).OLEObjects.Visible = False
ChDir "C:\****\****" ' folder name & file name
ActiveWorkbook.SaveAs Filename:="C:\****\****" & " " & Format(Now, "YYYY-MM-DD HH_MM_SS") & ".xls"
' this routine below will reopen workbook & delete contents if you want
Workbooks.Open Filename:="C:\****\*****.xls"
Range("A2:P500").Select ' select your own range !
Selection.ClearContents
Range("A2").Select
ActiveWorkbook.Save
End Sub