CODEWITHSUNDEEP
vbaexcel
Dannyboy
Dannyboy

Reputation: 257

Dynamically copy a worksheet multiple times and rename using VBA in Excel

I am trying to dynamically generate a custom number of worksheets based on a template that we use regularly in excel using VBA.

I have created an "Overview" page where we can input a range which will be used to name the new worksheets but then would like to use a hidden "Master" worksheet to generate the content of these new worksheets.

My code below currently generates the correct number of pages based on the range AND copies our master template page but does not combine the two and leaves them in separate pages.

Sub test()
Dim MyNames As Range, MyNewSheet As Range

Set masterSheet = ThisWorkbook.Worksheets("Master")
Set MyNames = Range("A1:A6").CurrentRegion  ' load range into variable

For Each MyNewSheet In MyNames.Cells    ' loop through cell range
    masterSheet.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy master template sheet
    Sheets.Add.Name = MyNewSheet.Value
Next MyNewSheet

MyNames.Worksheet.Select    ' move selection to original sheet
End Sub

As you can see, the code generates both the named (blank) worksheets AND copies my master worksheet which defaults to naming as "Master()". enter image description here

Upvotes: 1

Views: 7781

Answers (2)

Davesexcel
Davesexcel

Reputation: 6982

Loop through the list and copy the sheet if the sheet does not already exist.

Sub CopyMaster()
    Dim ws As Worksheet, sh As Worksheet
    Dim Rws As Long, rng As Range, c As Range
    Set sh = Sheets("Overview")
    Set ws = Sheets("Master")

    With sh
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = .Range(.Cells(1, 1), .Cells(Rws, 1))
    End With
    For Each c In rng.Cells
        If WorksheetExists(c.Value) Then
            MsgBox "Sheet " & c & " exists"
        Else:
            ws.Copy After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = c.Value

        End If
    Next c
End Sub
Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function

Upvotes: 1

Fadi
Fadi

Reputation: 3322

So we just need to replace this line:

Sheets.Add.Name = MyNewSheet.Value

with this line:

ActiveSheet.Name = MyNewSheet.Value

Upvotes: 2

Related Questions