How to copy the sheet name to a cell
 

I have some search coding I am using to create a summary sheet at the back
of a workbook. When the search criteria is met the entire row will e copied
over to the summary tab. What I need to do is also copy the sheet name with
that data so I know exactly where it came from. I don't have a clue how to
do this, can anyone guide me please.

CODING:

Option Explicit
Option Compare Text

Sub SeachSheets()
'
Dim FirstAddress As String, WhatFor As String
Dim Cell As Range, Sheet As Worksheet
'
WhatFor = InputBox("What are you looking for?", "Search Criteria")
If WhatFor = Empty Then Exit Sub
'
For Each Sheet In Sheets
If Sheet.Name < "SUMMARY" Then
With Sheet.Columns(6)
Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlPart)
Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Cell.EntireRow.Copy _
Destination:=Sheets("SUMMARY").Range("A" &
Rows.Count).End(xlUp).Offset(1, 0)
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address =
FirstAddress
End If
End With
End If
Next Sheet
'
Set Cell = Nothing
End Sub
Sub Clear()
Range("A4:K50").Select
Selection.ClearContents
Range("J18").Select
End Sub