Help on macro code

[siopao017]

Hi All,

I have a macro code for copying rows based on columns I want to copy and paste it into new worksheet. It open excel files in a folder and copy all data based on columns that I declared. The problem is that the code hyperlinks the sheet name and the cell where I copied the data. Is there a way that I can show the sheet name and cell where I copied it in the worksheet that I will paste the data? This is a borrowed code so I can't modify it, Thank you in advance for your help. Below is the macro code:

ption Explicit
Public Sub Main_1()
Dim intLastColumn As Integer
Dim wksSheetNew As Worksheet
Dim wksSheet As Worksheet
Dim intFiles As Integer
Dim varFiles As Variant
Dim lngLastRow As Long
Dim strFound As String
Dim rngRange As Range
Dim strLink As String
Dim wkbBook As Object
Dim strTMP As String
On Error GoTo Fin
varFiles = Application.GetOpenFilename( _
FileFilter:="Excel files (*.xls*), *.xls*", _
MultiSelect:=True)
If VarType(varFiles) = vbBoolean Then Exit Sub
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
For Each wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name Like "Found_*" Then
wksSheet.Delete
End If
Next wksSheet
'strFound = "Laptops"
strFound = InputBox("Enter search term!", "Total WIP", "Total WIP")
If Trim(strFound) = "" Then Exit Sub
Set wksSheetNew = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
wksSheetNew.Name = "Found_" & Format(Now, "dd_mm_yy_hh_mm_ss")
lngLastRow = 1
For intFiles = 1 To UBound(varFiles)
Set wkbBook = Workbooks.Open(varFiles(intFiles))
For Each wksSheet In wkbBook.Worksheets
If wksSheet.Name <> wksSheetNew.Name Then
Set rngRange = wksSheet.Columns("C:D").Find(What:=strFound, _
LookIn:=xlValues, LookAt:=xlPart)
If rngRange Is Nothing Then
Else
strLink = rngRange.Value
End If
If Not rngRange Is Nothing Then
strTMP = rngRange.Address
Do
lngLastRow = lngLastRow + 1
wksSheet.Cells(rngRange.Row, rngRange.Column).EntireRow.Copy _
Destination:=wksSheetNew.Cells(lngLastRow, 1)
intLastColumn = Cells(lngLastRow, Columns.Count).End(xlToLeft).Column + 1
Cells(lngLastRow, intLastColumn).Value = "Sheet"
wksSheetNew.Hyperlinks.Add Anchor:=wksSheetNew.Cells _
(lngLastRow, intLastColumn), Address:="", _
SubAddress:=wksSheet.Name & "!" & rngRange.Address, _
TextToDisplay:=wksSheet.Name
Set rngRange = wksSheet.Columns("C:D").FindNext(rngRange)
Loop While rngRange.Address <> strTMP
wksSheetNew.Cells.EntireColumn.AutoFit
End If
End If
Next wksSheet
wkbBook.Close False
Set wkbBook = Nothing
Next intFiles
Fin:
If Err.Number <> 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
If strTMP = "" Then
For Each wksSheet In ThisWorkbook.Worksheets
If wksSheet.Name Like "Found_*" Then
wksSheet.Delete
End If
Next wksSheet
MsgBox "Search term was not found!"
Else
MsgBox "All matching data has been copied."
End If
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set wkbBook = Nothing
Set rngRange = Nothing
Set wksSheetNew = Nothing
End Sub