コピーペーストの目的で、別のシートの列と一致させるために、ある列（別の列に基づく）の特定の値を選択するにはどうすればよいですか？

Question

"Sheet1"の営業担当者（列A）とクライアント（列BとC）のリストをループしています。

"Sheet1"の列Aを通過し、営業担当者に基づいて、列B & C（その営業担当者の範囲内）を参照し、 "Sheet2"の列Aと比較してください。 "Sheet1"の列BまたはCの値が "Sheet2"の列Aの値と一致する場合は、その行全体をコピーして、新しい "Sheet3"に貼り付けます。私は、ループ&条件文で取り組んできました

は、別のシートから条件に基づいてコピー＆ペーストする方法を考え出したが、「シート1」から列Aに基づいて指定した列B & Cとの間のリンク、に苦しんでいます、それらを "Sheet2"の列Aにマッチングさせることができる。

私はシートで何かを見つけて、コピーして別のシートに貼り付けるが、それは私がやりたいことのほんの一部であることができます。

Sub CopyCode() 

Dim r As Long, endrow As Long, pasterowindex As Long 

endrow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row 
    pasterowindex = 1 

For r = 1 To endrow 'Loop through sheet1 and search for your criteria 

    'Central CODE: 
    If Worksheets("sheet2").Cells(r, Columns("A").Column).Value = "CLIENT" Then 
     'get all value(s) in range of column d (and c eventually) 
     ' and see if they match values in column A of Readership paste 
     'if they do match values in column A of readership paste, 
     ' then copy that matched row into a new sheet 
     ' (will be designated by salesperson) 

     'Copy the current row 
     Rows(r).Select 
     Selection.Copy 

     'Switch to the sheet where you want to paste it & paste 
     Sheets("Sheet3").Select 
     Rows(pasterowindex).Select 
     ActiveSheet.Paste 

     'Next time you find a match, it will be pasted in a new row 
     pasterowindex = pasterowindex + 1 

     'Switch back to your table & continue to search for your criteria 
     Sheets("sheet2").Select 
    End If 

Next r 

End Sub 

Answer 1

for i = FirstRowA to LastRowA 'leaving you to figure out how to find these values 
    If cell(i) <> vbNullString Then 
      for h = FirstRowB to LastRowB 'again for you to figure out 
       If cell(h) = cell(i) Then 
        cell(h).copy 
        Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
        Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(0, 1).value = "Column b" 
       End If 
      Next h 

      for j = FirstRowC to LastRowC 'again you figure this out 
       If cell(j) = cell(i) Then 
        cell(j).copy 
        Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
        Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(0, 1).value = "column c" 
       end if 
      Next j 
     end if 
next i 

ここにいくつかの構文上の問題があるかもしれませんしかし、私は基本的にあなたが求めたループを与えました。これは、あなたが残りの部分をあなた自身で簡単に把握できるようになるまであなたを得ることができます。