Copy Entire row plus cell A1 and link to tab

[rowan853]

All,

Can anyone help, i have the below code which searches across all my tabs for a matching date range and returns the whole row.

I need to amend this to return the whole row + cell A1 + a link to that particular tab.

Any help appreciated.

Sub Button1_Click()

Dim Ws As Worksheet, LastI As Long, n As Long
Dim LastRow As Long

' clear master sheet except first 7 rows
Sheet1.UsedRange.Offset(7, 0).Delete

' Determine last used row in sheet 1
LastRow = Sheet1.Range("I" & Rows.Count).End(xlUp).Row + 1
If LastRow < 7 Then LastRow = 7
' get user dates
FirstDate = Sheet1.Range("B2").Value
Lastdate = Sheet1.Range("B3").Value

'Just tell user if dates need adding
If FirstDate = "" Or Lastdate = "" Then
    MsgBox "Please add valid dates to both cells B2 and B3"
    Exit Sub
End If

' Loop through sheets
For Each Ws In ThisWorkbook.Worksheets
    ' unless it's the master sheet..
    If Ws.Name <> Sheet1.Name Then
        'Find last used row in column I of that sheet...
        LastI = Ws.Range("I" & Rows.Count).End(xlUp).Row
        ' and loop through column I starting at row 2:
        For n = 2 To LastI
            With Ws.Cells(n, "I")
                If IsDate(.Value) And .Value >= FirstDate And .Value <= Lastdate Then
                    ' if date's in range, copy /paste to master sheet
                    .EntireRow.Copy Sheet1.Rows(LastRow)
                   
                    'Increment row counter for next match
                    LastRow = LastRow + 1
                End If
            End With
        Next n
    End If

Next Ws

' State (in A5) what the sheet now reports and tell user
Sheet1.Range("A5").Value = "Retrieved data matching above dates: from " & FirstDate & " to " & Lastdate
MsgBox "Done! Extracted " & LastRow - 7 & " matching rows"

End Sub