VBA Copying each cell that has a hyperlink in a row each to a new sheet, which has data from a Master template sheet

[JorgeSeminova]

Hello, I'm new to VBA and the code seems to work fine, except the texts pasted in the new sheets in cell B1 are not hyperlinked.

The hyperlinks are listed in each cell across Row 1 (starting at cell C1) in "HyperlinkSheet". The amount of cells filled with hyperlinks varies. Sometimes C1-AA1 are filled with hyperlinks, sometimes less or more.

The code is to create a new sheet with the hyperlink (pasted in B1) and a copy of the MasterTemplate sheet underneath. The text of the hyperlink is the name of each sheet. Since each hyperlink text is different. This all seems to work fine, however, the hyperlink isn't carrying over to the cell B1 of each new sheet. I'm really not sure how to fix this. I'd really appreciate the help Thank you!!!

Option Explicit

Public Sub NewSheets()

Dim shCol As Integer
Dim i As Long
Dim ws As Worksheet
Dim sh As Worksheet
Set ws = Sheets("MasterTemplate")
Set sh = Sheets("HyperlinkSheet")
stopAllEvents
shCol = 2
sh.Activate
For i = 1 To sh.Range("A1:CC1").Hyperlinks.Count
    shCol = shCol + 1
    sh.Hyperlinks(i).Range.Copy
    If isWorkSheet(sh.Cells(1, shCol).Text) = True Then GoTo Nextl 'check if worksheet is not already there else go to the next i
    Select Case shCol
    Case Is = 3
        ws.Copy After:=sh
    Case Else
        ws.Copy After:=Sheets(sh.Cells(1, shCol - 1).Text)
    End Select
    ActiveSheet.Name = sh.Cells(1, shCol).Text
    ActiveSheet.Range("B1").FormulaR1C1 = "='SprintSheet'!R1C" & shCol
    Application.CutCopyMode = False
Nextl:
Next i
sh.Activate
resetAllEvents
Application.StatusBar = False
End Sub

Public Sub stopAllEvents()
DisableEventsAll
End Sub

Public Sub resetAllEvents()
EnableEventsAll
End Sub

Public Sub DisableEventsAll()
With Application
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
End Sub

Public Sub EnableEventsAll()
With Application
    .StatusBar = "Resetting all events and calculations..."
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
End Sub

Public Function isWorkSheet(tSheet As Variant) As Boolean
Dim tmpSh As Worksheet
On Error Resume Next
Set tmpSh = ActiveWorkbook.Worksheets(tSheet)
isWorkSheet = Err.Number = 0
Err.Clear
On Error GoTo 0
End Function

 

[Alex Blakenburg]

You're welcome. Glad I could help.