title: Generated Hyperlink disappears when entering new Private Sub
body: <p>In the attached code, I am searching for a keyword, then creating a new sheet with row entries like file name, sheet, cell, data.  I am attempting to put in a hyperlink (thanks to <a href="https://stackoverflow.com/users/1140579/siddharth-rout">Siddharth Rout</a>)  to the found keyword in just the "cell" column (i.e. column "C" in this program).  The hyperlink created disappears when going into the new <code>Private Sub</code> which is where I extract the row data from the searched workbook resulting in the newly created file not containing any hyperlinks.  Can you help me maintain the hyperlinks in the newly created file?  Thanks.</p>
  
  <p>Here is the code: </p>
  
  <pre><code>Sub SearchFolders()
  'UpdatebySUPERtoolsforExcel2016
      Dim xFso As Object
      Dim xFld As Object
      Dim xStrSearch As String
      Dim xStrPath As String
      Dim xStrFile As String
      Dim xOut As Worksheet
      Dim xWb As Workbook
      Dim xWk As Worksheet
      Dim xRow As Long
      Dim xFound As Range
      Dim xStrAddress As String
      Dim xFileDialog As FileDialog
      Dim xUpdate As Boolean
      Dim xCount As Long
      On Error GoTo ErrHandler
      Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
      xFileDialog.AllowMultiSelect = False
      xFileDialog.Title = "Select a forlder"
      If xFileDialog.Show = -1 Then
          xStrPath = xFileDialog.SelectedItems(1)
      End If
      If xStrPath = "" Then Exit Sub
      xStrSearch = "failed"
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Create the report sheet at first position then name it "Summary"
    Dim wsReport As Worksheet, rCellwsReport As Range
    Set wsReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
    wsReport.Name = "Summary"
    Set rCellwsReport = wsReport.Cells(2, 2)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      xUpdate = Application.ScreenUpdating
      Application.ScreenUpdating = False
      Set xOut = wsReport
      xRow = 1
      With xOut
          .Cells(xRow, 1) = "Workbook"
          .Cells(xRow, 2) = "Worksheet"
          .Cells(xRow, 3) = "Cell"
          .Cells(xRow, 4) = "Test"
          .Cells(xRow, 5) = "Limit Low"
          .Cells(xRow, 6) = "Limit High"
          .Cells(xRow, 7) = "Measured"
          .Cells(xRow, 8) = "Unit"
          .Cells(xRow, 9) = "Status"
          Set xFso = CreateObject("Scripting.FileSystemObject")
          Set xFld = xFso.GetFolder(xStrPath)
          xStrFile = Dir(xStrPath &amp; "\*.xlsx")
          Do While xStrFile &lt;&gt; ""
              Set xWb = Workbooks.Open(Filename:=xStrPath &amp; "\" &amp; xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
              For Each xWk In xWb.Worksheets
                  Set xFound = xWk.UsedRange.Find(xStrSearch, LookIn:=xlValues)
                  If Not xFound Is Nothing Then
                      xStrAddress = xFound.Address
                  End If
                  Do
                      If xFound Is Nothing Then
                          Exit Do
                      Else
                          shName = xWk.Name
                          If InStr(1, shName, " ") Then shName = "'" &amp; shName &amp; "'"
                          xCount = xCount + 1
                          xRow = xRow + 1
                          .Cells(xRow, 1) = xWb.Name
                          .Cells(xRow, 2) = xWk.Name
                          .Cells(xRow, 3) = xFound.Address
                          Range("C" &amp; xRow).Formula = "=HYPERLINK(" &amp; Chr(34) &amp; "[" &amp; _
                                                xWb.FullName &amp; _
                                                "]" &amp; _
                                                shName &amp; _
                                                "!" &amp; _
                                                xFound.Address &amp; _
                                                Chr(34) &amp; "," &amp; Chr(34) &amp; _
                                                xFound.Address &amp; Chr(34) &amp; ")"
                          WriteDetails rCellwsReport, xFound
  
                      End If
                      Set xFound = xWk.Cells.FindNext(After:=xFound)
                  Loop While xStrAddress &lt;&gt; xFound.Address
              Next
              xWb.Close (False)
              xStrFile = Dir
          Loop
          .Columns("A:I").EntireColumn.AutoFit
          .Range("A1:A" &amp; xCount + 1).Rows.EntireRow.AutoFit
      End With
  
      MsgBox xCount &amp; "cells have been found", , "SUPERtools for Excel"
  ExitHandler:
      Set xOut = Nothing
      Set xWk = Nothing
      Set xWb = Nothing
      Set xFld = Nothing
      Set xFso = Nothing
      Application.ScreenUpdating = xUpdate
      Exit Sub
  ErrHandler:
      MsgBox Err.Description, vbExclamation
      Resume ExitHandler
  End Sub
  
  Private Sub WriteDetails(ByRef xReceiver As Range, ByRef xDonor As Range)
    xReceiver.Value = xDonor.Parent.Name
  
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Copy the row of the Donor to the receiver starting from column D.
    ' Since you want to preserve formats, we use the .Copy method
      xDonor.EntireRow.Resize(, 100).Copy xReceiver.Offset(, 2)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set xReceiver = xReceiver.Offset(1)
  
  End Sub
  </code></pre>