Excel VBA来select包含文本string的单元格,然后将这些单元格复制并粘贴到新的工作簿中

我是一个狂热的Excel用户,但在VBA中不强。 任何帮助表示赞赏。 以下是我正在尝试的步骤。

在B列中查找文本string。 – 使用偏移量收集位于此string周围的两个值。 偏移量(4,0)和偏移量(3,10) – 这样做总共四次,这使我们有8个值。 – 将8个值粘贴到另一个工作簿中最后一行的8个连续单元格中

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 

我认为这是一个体面的开始。 我将存储我在数组中search的内容,并通过它进行循环

 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 

顺便说一下,不需要select或激活任何东西。 只要把它作为一个像我一样的对象。