Ok so I wrote my own code which works pretty good but I know it can be less steps in the process.

Sub RenameNewSheet()
    Dim MyCell As Range, MyRange As Range, MyRange1, MyRange2, MyRange3, MyRange4, MyRange5, MyRange6, MyRange7, MyRange8, MyRange9
    Dim wsSource As Worksheet

    'This Macro will create separate tabs based on a list in Distribution Tab A2 down

    Worksheets("WBS_Items").Select

    'Column A WBS No
    Set MyRange = Sheets("WBS_Items").Range("A9")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    'Column B Part No
    Set MyRange1 = Sheets("WBS_Items").Range("Partno")
    Set MyRange1 = Range(MyRange1, MyRange1.End(xlDown))

    'Column C Description
    Set MyRange2 = Sheets("WBS_Items").Range("Desc")
    Set MyRange2 = Range(MyRange2, MyRange2.End(xlDown))

    'Column D Qty
    Set MyRange3 = Sheets("WBS_Items").Range("QTY")
    Set MyRange3 = Range(MyRange3, MyRange3.End(xlDown))

    'Column E Each
    Set MyRange4 = Sheets("WBS_Items").Range("EachAmt")
    Set MyRange4 = Range(MyRange4, MyRange4.End(xlDown))

    'Column G Material Cost1
    Set MyRange5 = Sheets("WBS_Items").Range("MATCOST")
    Set MyRange5 = Range(MyRange5, MyRange5.End(xlDown))

    'Column J Material Cost Freight Estimate
    Set MyRange6 = Sheets("WBS_Items").Range("MTLFRGT")
    Set MyRange6 = Range(MyRange6, MyRange6.End(xlDown))

    'Column X Quality Labor Hours
    Set MyRange7 = Sheets("WBS_Items").Range("X13")

    'Column X Assembly Wireman Labor Hours
    Set MyRange8 = Sheets("WBS_Items").Range("X15")

    'Column M Material and Labor markup %
    Set MyRange9 = Sheets("WBS_Items").Range("X15")

    Dim MyDate

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each MyCell In MyRange

'        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        copy_template
            Sheets("Newsht").Activate
            Sheets("Newsht").Cells(23, 6) = "1"
            Range("E8").Value = Sheets("PROJECT_INFORMATION").Range("A2")
            MyDate = Sheets("PROJECT_INFORMATION").Range("G2")
            Range("G8").Value = MyDate
            Range("I8").Value = Sheets("PROJECT_INFORMATION").Range("D2")
            Range("A1").Select
            Sheets("Newsht").Cells(23, 6) = "0"

            applydata

            Sheets("Newsht").Select

            Sheets("Newsht").Name = MyCell.Value ' renames the new worksheet

            Range("N8").Value = MyCell.Value 'add wbs no to worksheet

            Range("A1").Select

   Next MyCell

HideSheets

    RebuildSell
    Application.Calculation ...

Thank you. I found my answer:

'Put this in the worksheet module: 
Private Sub Worksheet_Change(ByVal Target As Range) 
'change "c:\tmp\" to whatever reference you need 
'a cell, a public variable, a fixed string 

If Target.Column = 7 Then 'If by column use this, if not just delete IF part of statement but then any cell will hyperlink.
   MakeHyperLink Target, "c:\tmp\" 
   End If
    End Sub 

'Put this in the standard module: 
Public Function MakeHyperLink(InRange As Range, _ 
ToFolder As String, _ 
Optional InSheet As Worksheet, _ 
Optional WithExt As String = "doc") As String 
Dim rng As Range 
Dim Filename As String 
Dim Ext As String 
'check to see if folder has trailing \ 
If Right(ToFolder, 1) <> "\" Then 
Filename = ToFolder & "\" 
Else 
Filename = ToFolder 
End If 
'check to see if need ext 
If WithExt <> "" Then 
'check to see if ext has leading dot 
If Left(WithExt, 1) <> "." Then 
WithExt = "." & WithExt 
End If 
End If 

Thank you AndreRet for you input but believe I can use that too. Thank you again.

AndreRet commented: Well done in solving your problem. :) +12