Excel VBAを使用してテキスト文字列を含むセルを選択し、これらのセルをコピーして新しいブックに貼り付けます。

Question

私はavidユーザーですが、vbaでは強力ではありません。どんな助けもありがとうございます。ここに私がやろうとしているステップがあります。

列Bでテキスト文字列を検索します。 - この文字列の周囲にある2つの値を収集するためにオフセットを使用します。オフセット（4,0）とオフセット（3,10） - これを合計4回実行すると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 

Answer 1

-paste 。私が探していたものを配列に格納してループします。

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 

ところで、何も選択したりアクティブ化する必要はありません。私がしたようにそれをオブジェクトとして参照してください。