Macro help in copying data from multiple sheets to first Sheet of workbook based on condn

Hi,

I wanted to copy data from multiple sheets to first sheet (master) if value in column D is found as "Arc" (suppose).
I don't want to hard code this value instead wanted to use input box.

Any help appreciated. As i am new to VBA.


I tried something but seems there is some issue. Below is my code which i tried. Please help me to solve the issue.
Sub CombineData()
Dim Sht As Worksheet
Dim strToFind As String, FirstAddress As String
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "master" Then
Sht.Select
Application.ScreenUpdating = False

strToFind = InputBox("Enter the Action Item On")
For r = 1 To 5
With ActiveSheet.Range("A1:AY23331")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Worksheets("master").Range("A" & Rows.Count).End(xlUp).Row + 1

rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress

End If
End With
Next r
End If
Next Sht
End Sub

Regards,
Archies

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim bottomD As Integer
    Dim ws As Worksheet
    Dim rng As Range
    Dim strToFind As String
    strToFind = InputBox("Enter the Action Item On")
    For Each ws In Sheets
        If ws.Name <> "Master" Then
            ws.Activate
            bottomD = Range("D" & Rows.Count).End(xlUp).Row
            For Each rng In Range("D2:D" & bottomD)
                If rng = strToFind Then
                    rng.EntireRow.Copy Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                End If
            Next rng
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub