Need a VBA macro to copy a hidden tab and rename it based on the cells in a different sheet.

[PFCSC]

Hi All,

I am new to Mr. Excel and VBA codes so please bare with me. Essentially, I need a code for a button that will copy a hidden tab, duplicate itself a number of times, then and rename the copied tabs based on the cell names in a different sheet.

So for Sheet1 I have the button and a list of tab names in cells D5:D55. I have Sheet2 hidden, but Sheet2 is a model tab of what I want duplicated. So I would like Sheet2 copied and duplicated, then renamed based on the data in sheet1 D5:D55. I would like it done in a way so that if 50 names are in D5:D55 when the button is pressed, 50 copies of Sheet2 will appear unhidden and each of the sheets are named based on the values of D5:D55. It also needs to work if only 2 or 3 names are entered in d5:d55 so that only 2 or 3 tabs appear and are named based on the values of d5:d55. Lastly I would like Sheet2 to hide itself again after the copies have been made and renamed.

Hoping you can help!

Thanks,

 

[JackDanIce]

Welcome to the board. Try:

Sub CopySheet2()

    Dim rng     As Range
    Dim rngLoop As Range
    Dim ws2     As Worksheet
    Dim x       As Long
    
    Set ws2 = Sheets("Sheet2")
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
        x = Application.Max(5, .Cells(.Rows.Count, 4).End(xlUp).row)
        If x > 55 Then x = 55
        Set rngLoop = .Cells(4, 5).Resize(x - 4)
    End With
    
    With ws2
        .Visible = xlSheetVisible
        
        For Each rng In rngLoop
            .Copy after:=Sheets(Sheets.Count)
            ActiveSheet.Name = rng.Value
        Next rng
        
        .Visible = xlSheetHidden
    End With
        
    Sheets("Sheet1").Activate
    
    Application.ScreenUpdating = True
    
    Set rngLoop = Nothing
    Set ws2 = Nothing

End Sub

 

[Roger Govier]

Hi

There is no need to unhide the hidden sheet
The following code also calls a function to check that the Name doesn't already appear in the Workbook.
If it does, then it give the use a warning and stops, as you can't have duplicate sheet names.

Sub CopySheets()
    Dim numrows As Long, i As Long
    Dim sname As String
    With Sheets("Sheet1")
        numrows = WorksheetFunction.CountA(.Range("D5:D55"))
        If numrows = 0 Then Exit Sub
        For i = 1 To numrows
            If Contains(Sheets, .Cells(i + 4, "D").Value) Then
                sname = .Cells(i + 4, "D").Value
                Call MsgBox(sname & "  Sheet name already exists. Remove from List and try again", vbCritical, Application.Name)
                Exit Sub
            End If
            ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
            ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 4, "D").Value
        Next
    End With
End Sub
Function Contains(objCollection As Object, strName As String) As Boolean
    Dim o As Object
    On Error Resume Next
    Set o = objCollection(strName)
    Contains = (Err.Number = 0)
    Err.Clear
 End Function

 

[PFCSC]

Hi Jack,

Thank you for your reply. Unfortunately I am running into an issue and it is bringing up the debugger at "ActiveSheet.Name = rng.Value".

It looks like sheet2 has unhidden and a new tab has appeared called Sheet2 (2) but has stopped there.

Any ideas?

Thank you!

 

[JackDanIce]

Try Roger's code, it could be the value in D5 (or whatever cell) can't be assigned to the copied sheet, because the name already exists; Roger's code accounts for this. If not, reply back with the specific error message.

 

[PFCSC]

Hi Rodger,

Thank you for your reply. Unfortunately I am running into an issue with:
"ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)"

The debugger comes up and tells me there is an issue there. Sheet2 has renamed itself as the first value I have in D5 but has stopped there. The new sheet is hidden and not visible.

Any ideas?

Thank you!

 

[PFCSC]

please help!

 

[PFCSC]

Hi

There is no need to unhide the hidden sheet
The following code also calls a function to check that the Name doesn't already appear in the Workbook.
If it does, then it give the use a warning and stops, as you can't have duplicate sheet names.

Sub CopySheets()
    Dim numrows As Long, i As Long
    Dim sname As String
    With Sheets("Sheet1")
        numrows = WorksheetFunction.CountA(.Range("D5:D55"))
        If numrows = 0 Then Exit Sub
        For i = 1 To numrows
            If Contains(Sheets, .Cells(i + 4, "D").Value) Then
                sname = .Cells(i + 4, "D").Value
                Call MsgBox(sname & "  Sheet name already exists. Remove from List and try again", vbCritical, Application.Name)
                Exit Sub
            End If
            ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
            ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 4, "D").Value
        Next
    End With
End Sub
Function Contains(objCollection As Object, strName As String) As Boolean
    Dim o As Object
    On Error Resume Next
    Set o = objCollection(strName)
    Contains = (Err.Number = 0)
    Err.Clear
 End Function

Hi Rodger,

Thank you for your reply. Unfortunately I am running into an issue with:
"ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)"

The debugger comes up and tells me there is an issue there. Sheet2 has renamed itself as the first value I have in D5 but has stopped there. The new sheet is hidden and not visible.

Any ideas?

Thank you!

 

[PFCSC]

Hi Rodger,

Thank you for your reply. Unfortunately I am running into an issue with:
"ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)"

The debugger comes up and tells me there is an issue there. Sheet2 has renamed itself as the first value I have in D5 but has stopped there. The new sheet is hidden and not visible.

Any ideas?

Thank you!

Hey Rodger,

I got it to work. Thank you for giving me your VBA code. Just to close up this question I want to point out that it turns out that the macro only works when Sheet2 is unhidden. If it is hidden you run into the problems I had described above. Not sure why. Anyways, I slightly amended your code, and now it works perfectly. Here you go:

Sub rodgermacro()
Sheets("Sheet2").Visible = True
Dim numrows As Long, i As Long
Dim sname As String
With Sheets("Sheet1")
numrows = WorksheetFunction.CountA(.Range("D5:D55"))
If numrows = 0 Then Exit Sub
For i = 1 To numrows
If Contains(Sheets, .Cells(i + 4, "D").Value) Then
sname = .Cells(i + 4, "D").Value
Call MsgBox(sname & " Sheet name already exists. Remove from List and try again", vbCritical, Application.Name)
Exit Sub
End If
ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
ThisWorkbook.Sheets(Sheets.Count).Name = .Cells(i + 4, "D").Value
Next
Sheets("Sheet2").Visible = False
End With
End Sub
Function Contains(objCollection As Object, strName As String) As Boolean
Dim o As Object
On Error Resume Next
Set o = objCollection(strName)
Contains = (Err.Number = 0)
Err.Clear
End Function


Notice how I make Sheet2 Visible or unhidden as the first step, and just before the first end sub I inserted Sheets("Sheet2").Visible = False so that the tab that is being duplicated ends hidden again.

Thank you for your help. Just out of curiosity, where did you learn VBA coding? a class? a hobby? work?