Every Time Copy From ActiveSheet Only - excel

Question

i have used this vba in my workbook
To copy entire row data based on given value from inputbox from active sheet to another existing sheet by given value in first inputbox of this strName = Trim(InputBox("What are you looking for?")) and second inputbox will ask to enter Sheet Name Set OutputWs = Worksheets(InputBox("Enter Sheet Name")) and third inputbox will ask to enter column name OutputWs.Cells(Rows.count, InputBox("Enter Column Name")).End(xlUp).Row and then matched given value data from that column of entire row should be copy from active sheet to another sheet given sheet name by inputbox in workbook & here it’s successfully copying
Here what the problem i have getting when i using this vba it’s copying matched data by given value from another sheets also
Here what i want this vba will copy matched data by given value from active sheet only not from another sheets & if I copy matched data by given value from another sheet i mean another active sheet to same OutputWs Sheet then first copied data should not be over written it will look for next blank cell or row to copy the data from there
And one more thing when i enter new sheet name in inputbox then i have getting this Error
Run-time error ‘9’:
Subscript out of range
On this line
Set OutputWs = Worksheets(InputBox("Enter Sheet Name"))
Sub SearchAll()
Dim ws As Worksheet, OutputWs As Worksheet
Dim rFound As Range, IsValueFound As Boolean, IsValueNotFound As Boolean
Dim strName As String
Dim count As Long, LastRow As Long
strName = Trim(InputBox("What are you looking for?"))
If strName = "" Then Exit Sub
Set OutputWs = Worksheets(InputBox("Enter Sheet Name"))
LastRow = OutputWs.Cells(Rows.count, InputBox("Enter Column Name")).End(xlUp).Row
For Each ws In Worksheets
If ws.Name <> OutputWs.Name Then
Debug.Print "Checking " & ws.Name
Set rFound = FindAll(ws.UsedRange, strName)
If Not rFound Is Nothing Then
Set rFound = rFound.EntireRow
count = rFound.Cells.count / Columns.count 'how many matched rows?
Debug.Print "Found " & count & " rows"
rFound.Copy OutputWs.Cells(LastRow + 1, 1)
LastRow = LastRow + count
IsValueFound = True
IsValueNotFound = True
End If
End If
Next ws
If IsValueFound Then
OutputWs.Select
MsgBox "Results pasted to " & "(" & OutputWs.Name & ")" & " Sheet"
Else
If IsValueNotFound Then
OutputWs = MsgBox("Sheet " & OutputWs.Name & " Not Found in WorkBook Do you want Create a New Sheet with Given Name Then Click Yes", vbQuestion + vbYesNo)
If OutputWs = vbYes Then
Worksheets.Add OutputWs.Name
End If
End If
End If
End Sub
Public Function FindAll(rng As Range, val As String) As Range
Dim rv As Range, f As Range
Dim addr As String
Set f = rng.Find(what:=val, After:=rng.Cells(rng.Cells.count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
If rv Is Nothing Then
Set rv = f
Else
Set rv = Application.Union(rv, f)
End If
Set f = rng.FindNext(After:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function