Copy sheet based on cell value, but if this value exits in sheets don't create it

MichaelFl

New Member
Joined
Sep 18, 2018
Messages
2
Hi,

I'm trying create a copy of the active sheet and name it based on a cell value ("H1" is text January) using a command button.
This works fine. But the problem i run into is that when the name already exist I get an error 1004. Then it creates a copy of the sheet name like "test (2)".
What I want is when this value already exist in the sheets, it should not make a copy an no error.
So only make a copy if the value not exists.

This is the code:


Private Sub CommandButton1_Click()
Dim ws As Worksheet


Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
If wh.Range("H1").Value <> "" Then
ActiveSheet.Name = wh.Range("H1").Value


ActiveSheet.Shapes("CommandButton1").Delete

End
End If


wh.Activate




End Sub

Thanks in advance!
Michael
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,676
Hi MichaelFl,

Welcome to MrExcel!!

Though you have declared a ws worksheet variable you don't use it in the code? Using Option Explicit as I have done with the following will prevent this:

Code:
Option Explicit
Sub Macro1()

    Dim ws As Worksheet
    Dim strSheetName As String
    
    Application.ScreenUpdating = False

    On Error Resume Next
        If Len(ActiveSheet.Range("H1")) > 0 Then
            Set ws = Sheets(CStr(ActiveSheet.Range("H1")))
            If Err.Number <> 0 Then
                strSheetName = CStr(ActiveSheet.Range("H1"))
                ActiveSheet.Copy After:=Worksheets(Sheets.Count)
                With Worksheets(Sheets.Count)
                    .Name = strSheetName
                    .Shapes("CommandButton1").Delete
                End With
            End If
        End If
    On Error GoTo 0
    
    Application.ScreenUpdating = True

End Sub

Though I'm not a fan of having separate tabs, the above should do the job for you.

Hope that helps,

Robert
 

MichaelFl

New Member
Joined
Sep 18, 2018
Messages
2
Hi Robert,

Thanks for your fast reply!
Yes it works for me!
I am new to VBA and trying to understand the codes by trying, reading and help from this forum.

This certainly will help me in my learning curve :)
Thanks!
Michael
 

Watch MrExcel Video

Forum statistics

Threads
1,109,533
Messages
5,529,395
Members
409,870
Latest member
Well59
Top