Excel VBA to select cells that contain a text string, and then copy and paste these cells into a new workbook

Question

I am an avid excel user but not strong in vba. Any help is appreciated. Here are the steps that I am trying to do.

Find string of text in column B. -Use offset to gather two values located around this string. offset(4,0) and offset(3,10) - Do this a total of four times which gets us 8 values. -paste the 8 values into 8 consecutive cells at the last row within another workbook

  Set wkb = Excel.Workbooks.Open("c:\users\jojames\desktop\skillset performance with talktime.xls")
  Set wks = wkb.Worksheets("Sheet1"): wks.Activate

  find1Allscripts = "Allscripts - 10055"
  Set Match1 = wks.Cells.Find(find1Allscripts)
  findoffset1a = Match1.Offset(4, 0).Value
  findoffset1b = Match1.Offset(3, 10).Value

  find2Tier1 = "Tier1_ServiceDesk - 10052"
  Set Match2 = wks.Cells.Find(find2Tier1)
  findoffset2a = Match2.Offset(4, 0).Value
  findoffset2b = Match2.Offset(3, 10).Value

  find3Tier2 = "Tier2_ServiceDesk - 10053"
  Set Match3 = wks.Cells.Find(find3Tier2)
  findoffset3a = Match3.Offset(4, 0).Value
  findoffset3b = Match3.Offset(3, 10).Value

  find4Office = "Allscripts - 10055"
  Set Match4 = wks.Cells.Find(find4Office)
  findoffset4a = Match4.Offset(4, 0).Value
  findoffset4b = Match4.Offset(3, 10).Value

  'Paste the values'
  Set wkb2 = ThisWorkbook
  Set wks2 = wkb2.Sheets("ACD Data")

  wks2.Activate

  LastRow = wks2.Range("Y" & wks2.Rows.Count).End(xlUp).Row + 1

  ActiveSheet.Range("Y" & LastRow).PasteSpecial xlPasteFormulas

  Set wks = Nothing: Set wkb = Nothing

  Set wks2 = Nothing: Set wkb2 = Nothing

Answer 1

I think this is a decent start. I would store what I was searching for in an array and loop through it

myArray = Array("Allscripts -1005", "Tier1_ServiceDesk - 10052", ...)
for i = lbound(myArray) to ubound(myArray)
    Set Match1 = wks.Cells.Find(myArray(i))
    if not Match1 is Nothing then
        LastRow = wks2.Range("Y" & wks2.Rows.Count).End(xlUp).Row + 1
        wks2.Range("Y" & LastRow) = Match1.Offset(4,0).Value
        wks2.Range("Z" & LastRow) = Match1.Offset(3,10).Value
    end if
next i

By the way, no need to select or activate anything. Just refer to it as an object like I did.