Button to save range from active sheet as a new sheet

E_Sean_Sullivan 

Your intent is not fully described.

• Do you want to copy the cells as-is (including the formulas, which may break on the new sheet because referenced cells are not present there)?  Or do you want to copy just the values?  Or maybe the values and the formats?  Do you want to copy the column widths?  (Or maybe prompt the user for choices?  But at this time I'll leave that possibility for you to consider coding.)
• Do you want the selected cells to be pasted into the top left of the worksheet (into A1), or to the same location on the new worksheet as they have on the source sheet?

Your function SheetExists will work as-is.  The function GetName refers to the active worksheet, which will change before the copy is completed, so I coded to use instead a function GetNameFromA1 (which has a more specific name, requires a Worksheet argument, and includes variables with more meaningful names).  I coded Button3_Click including some commented-out code to allow you to easily switch between some options.

Sub Button3_Click()
    
    Dim objSourceWksht  As Worksheet
    Dim objTargetWksht  As Worksheet
    Dim rngSource   As Range
    Dim rngTarget   As Range
    Dim strSourceAddress    As String
    
    '----   Grab a reference to this worksheet.  ("Me" would work
    '       throughout, but the usage intent may be clearer using
    '       the variable.)
    Set objSourceWksht = Me
    
    '----   Grab a reference to the currently-selected cells (because
    '       the next code block will change the selection).
    Set rngSource = Selection
    '  --
    strSourceAddress = rngSource.Address
    
    '----   Create a new worksheet, placing it after all existing
    '       worksheets.
    Set objTargetWksht = Sheets.Add(, Sheets(Sheets.Count), , xlWorksheet)
    
    '----   Rename the new worksheet.
    objTargetWksht.Name = GetNameFromA1(objSourceWksht)
    
    '----   Establish where the copy is to be pasted.
    '   Perhaps:
    Set rngTarget = objTargetWksht.Range("A1")
    '   Or perhaps:
    'Set rngTarget = objTargetWksht.Range(strSourceAddress)
    
    '----   Copy the range of cells and - in one or more steps -
    '       paste them to the new sheet.
    rngSource.Copy
    '  --
    rngTarget.PasteSpecial Paste:=xlPasteAll
    '...or, if you want just the values:
    'rngTarget.PasteSpecial Paste:=xlPasteValues
    '...or if you want the values and the formats, follow the
    '   prior statement with:
    'rngTarget.PasteSpecial Paste:=xlPasteFormats
    '  --
    '...In spite of the name xlPasteAll, the following is not
    '   included [but you may choose not to copy widths]:
    rngTarget.PasteSpecial Paste:=xlPasteColumnWidths
    '  --   Take the application out of cut/copy mode.
    Application.CutCopyMode = False

End Sub

Private Function GetNameFromA1(ByVal SheetWithNameInA1 As Worksheet) As String
'   Determine the next available worksheet name using either the
'       contents of cell A1 of the specified sheet, or by appending
'       a sequence number to that base name.
    Dim strBaseName As String
    Dim in4AppendNum    As Long
    Dim strNewName  As String
    
    '----
    strBaseName = SheetWithNameInA1.Range("A1").Value
    If SheetExists(strBaseName) Then
        Do
            in4AppendNum = in4AppendNum + 1
            If Not SheetExists(strBaseName & in4AppendNum) Then
                Exit Do
            End If
        Loop
        strNewName = strBaseName & in4AppendNum
    Else
        strNewName = strBaseName
    End If
    GetNameFromA1 = strNewName
End Function

Note: This code works only with contiguous (rectangular) cell selection.

Note also: As a matter of good software design… If you create much code in the Button3_Click event handler, such as prompting the user for information, it likely becomes appropriate to use the event handler only for the user interface, and move the code that does the create_worksheet+copy+paste into a new procedure, passing the necessary data to the latter.

Hi E_Sean_Sullivan,

you can try this as a solution for a button to save a range of cells from the active sheet as a new sheet:

Sub Button3_Click()
    ' Create a Range variable to store the range of cells to copy.
    Dim rng As Range

    ' Select the range of cells to copy.
    Set rng = ActiveSheet.Range("A1:B10")

    ' Copy the range of cells to the new sheet.
    rng.Copy after:=Sheets(Sheets.Count)

    ' Name the new sheet.
    Sheets(Sheets.Count).Name = GetName
End Sub

Private Function GetName() As String
    Dim x As Long, n As String
    n = ActiveSheet.Range("A1")
    If SheetExists(n) Then
        Do
            x = x + 1
            If Not SheetExists(n & x) Then Exit Do
        Loop
        n = n & x
    End If
    GetName = n
End Function

Private Function SheetExists(aName As String) As Boolean
    On Error Resume Next
    Dim sh As Worksheet: Set sh = Sheets(aName)
    If Err = 0 Then SheetExists = True Else SheetExists = False
End Function

To use this code, simply select the range of cells that you want to copy and then click the button. The code will create a new sheet at the end of the workbook and copy the range of cells to the new sheet.

You can also modify the code to copy a range of cells from a different sheet, or to copy multiple ranges of cells to the new sheet. To do this, simply modify the Range() function in the Button3_Click() subprocedure to select the range of cells that you want to copy.