Copy a template if Master is Yes, rename with cell data

[Newbie4296]

I have a loop that will look at a Master sheet of data. It looks at a particular column for data to "trigger" the copying of a Template, renames the Template the "trigger cell" value, it also copies the "trigger cell" value and pastes it into a cell in the new copy of the template copy info from the master. It also adds a hyper link to the "trigger cell" and continues until it runs down the column and hits a blank cell.

It works, if there are no spaces and no duplicates.

What I want to do is add a "Yes" column that will trigger the copy and do everything it currently does but not all the rows will be one right after another, so I can pick and choose what data is copied. A selective loop if you will.

I did copy this code from somewhere, I don't recall but it may have been from here. Thank you in advance!



Sub Macro10()

Dim rngCreateSheets As Range
Dim oCell As Range

Dim oTemplate As Worksheet
Dim oSummary As Worksheet
Dim oDest As Worksheet

Set oTemplate = Worksheets("Template")
Set oSummary = Worksheets("Master")
Set rngCreateSheets = Worksheets("Master").Range("B18", Range("B18").End(xlDown))
'Above line assumes NO blank cells

For Each oCell In rngCreateSheets.Cells

oTemplate.Copy After:=Worksheets(Sheets.Count)
Set oDest = ActiveSheet
oDest.Name = oCell.Value

oDest.Range("N4").Value = oCell.Value

oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
oDest.Name & "!N4", TextToDisplay:=oDest.Name
Next oCell

End Sub

 

[Alex Blakenburg]

Let's start with this:
(It assumes that you have flagged the column next to it (ie column C) with a Yes or at least Y)

Sub CreateTemplates()

    Dim rngCreateSheets As Range
    Dim oCell As Range
    
    Dim oTemplate As Worksheet
    Dim oSummary As Worksheet
    Dim oDest As Worksheet
    Dim sDestName As String
    
    Set oTemplate = Worksheets("Template")
    Set oSummary = Worksheets("Master")
    Set rngCreateSheets = Worksheets("Master").Range("B18", Range("B18").End(xlDown))
    'Above line assumes NO blank cells
    
    For Each oCell In rngCreateSheets.Cells
        
        sDestName = oCell.Value
        ' Check if next column has been flagged for inclusion
        If UCase(Left(oCell.Offset(, 1).Value, 1)) = "Y" Then
        ' Check if sheet already exists
            If Evaluate("ISREF('" & sDestName & "'!A1)") = False Then
                oTemplate.Copy After:=Worksheets(Sheets.Count)
                Set oDest = ActiveSheet
                oDest.Name = sDestName
                
                oDest.Range("N4").Value = oCell.Value
                
                oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _
                oDest.Name & "!N4", TextToDisplay:=oDest.Name
            End If
        End If
    Next oCell

End Sub

 

[Newbie4296]

Worked, thank you, I truly appreciate the assistance!

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.