Copy a sheet and clear contents in the same time-CodePudding

Am am using this function for clearing contents

Sub ClearData()

Range("K2,J3,B18:B38,H18:H38,I18:I38,J18:J38,F44").Value = ""

End Sub

And this other function to copy the last sheet with the same content and also give it a name

Public Sub CopySheetAndRename()
  Dim newName As String

  On Error Resume Next
  newName = InputBox("Enter the name for the copied worksheet")

  If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = newName
  End If
  
End Sub

But what I need is that when I press the button to create the new copied sheet I also what to clear some cells in the new sheet. Now I have two buttons and I want only one button that must do what the other 2 are doing.

I am new at this and still learning.

I tried to combine the code but with no luck.

CodePudding user response：

You can call the other macro from a macro. In your CopySheetAndRename macro, if you write Call ClearData or even just ClearData (since VBA can figure out the Call part by itself), VBA will run ClearData inside your CopySheetAndRename macro.

Public Sub CopySheetAndRename()
  Dim newName As String

  On Error Resume Next
  newName = InputBox("Enter the name for the copied worksheet")

  If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = newName
    ClearData
  End If
  
End Sub

My advice for your code would be to not use ActiveSheet. As your code gets more complicated, especially when you're creating or changing sheets mid-execution, ActiveSheet will be hard to keep track of, and may end up causing problems for you. In my experience, something ends up running on the wrong sheet and damaging all the data.

Add a Worksheet argument to ClearData so that you can be sure you're not running it on the wrong sheet. And save the new sheet as a variable as soon as possible, before anything else changes ActiveSheet.

Sub ClearData(Target As Worksheet)
  Target.Range("K2,J3,B18:B38,H18:H38,I18:I38,J18:J38,F44").Value = ""
End Sub
Public Sub CopySheetAndRename()
  Dim newName As String

  On Error Resume Next
  newName = InputBox("Enter the name for the copied worksheet")

  If newName <> "" Then
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    Dim ws as Worksheet
    Set ws = Worksheets(Worksheets.Count)
    On Error Resume Next
    ws.Name = newName
    ClearData ws
  End If
  
End Sub

CodePudding user response：

Duplicate Worksheet

Option Explicit

Sub DuplicateWorksheet()
    
    ' Define constants.
    Const PROC_TITLE As String = "Duplicate Worksheet"
    Const IB_PROMPT As String = "Enter the name for the duplicate worksheet"
    Const CLEAR_RANGE As String = "K2,J3,B18:B38,H18:H38,I18:I38,J18:J38,F44"
    
    ' Input the destination worksheet name.
    Dim NewName As String: NewName = InputBox(IB_PROMPT, PROC_TITLE)
    
    ' Check if no entry or the dialog was canceled.
    If Len(NewName) = 0 Then
        MsgBox "No name entered.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Reference the source worksheet and the workbook.
    Dim sws As Worksheet: Set sws = ActiveSheet
    Dim wb As Workbook: Set wb = sws.Parent
    
    Application.ScreenUpdating = False
    
    ' Copy the source and reference this copy, the destination worksheet.
    sws.Copy After:=wb.Sheets(wb.Sheets.Count) ' after last sheet
    Dim dws As Worksheet: Set dws = wb.Sheets(wb.Sheets.Count) ' last sheet
    
    Dim ErrNum As Long
    
    ' Attempt to rename the destination worksheet.
    On Error Resume Next ' prevent several possible errors
        dws.Name = NewName
        ErrNum = Err.Number
    On Error GoTo 0
    
    ' Check if the rename was successful.
    If ErrNum <> 0 Then ' could not rename
        Application.DisplayAlerts = False
            dws.Delete
        Application.DisplayAlerts = True
        MsgBox "Could not rename to '" & NewName & "'.", _
            vbExclamation, PROC_TITLE
        Exit Sub
    'Else ' could rename; do nothing (continue)
    End If
    
    ' Clear.
    dws.Range(CLEAR_RANGE).ClearContents
               
    ' Save!?
    'ws.Save
               
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "The name of the duplicated worksheet is '" & NewName & "'.", _
        vbInformation, PROC_TITLE
  
End Sub