Multiple items Search, select, copy and past in new sheet!

Hi there, I'm new here and would appreciate if you could give me some help.
I have a workbook with lots of text in it and i want to Search Multiple items, select, copy and paste them in a new sheet. The items are IO Inputs and Outputs from a PLC (AA:0.I.Data.0, AB:0.I.Data.0...)

I found this VBA code on the forum, but is not really what i need. I don't need a input box and all items i need are in column B.


Public Sub FindText()
'Run from standard module, like: Module1.
'Find all data on all sheets!
'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer

myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub

Sheets("Search").Select
Range("A2:L625748").Select
Selection.ClearContents
Range("A1").Select

For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search Search sheet
If ws.Name = "Search" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf

Set Found = .UsedRange.FindNext(Found)

'Copy found data row to sheet4 Option!
Found.EntireRow.Copy _
Destination:=Worksheets("Search").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub