| 
    
     |  | 1or8 さん 
 こんばんは。
 アドバイスありがとうございます。
 仰るとおりですね。実行してみたらできました。
 
 ちなみに、常に隣に貼り付けるのではなくて、
 E列に詰めて貼り付ける事は可能でしょうか?
 
 E列・F列で
 オブジェクト.SpecialCells(xlCellTypeBlanks).Select
 オブジェクト.Delete Shift:=xlShiftUp
 
 上記の内容が実行できれば良いのかと思いますが、
 申し訳ございませんが、ご教授お願い致します。
 
 
 ▼1or8 さん:
 >▼bon さん:
 >こんばんは。
 >
 >>Excelで下記のような表を作りました。
 >>
 >>商品名      単価     備考
 >>Word入門      1000     加藤
 >>Word応用      2000     田中
 >>Excel入門      1000     山本
 >>Excel応用      2000     高橋
 >>Word入門      1200     木村
 >>
 >>この中で“Word入門”が商品名の中に2つ入っているのですが、
 >>表の中から“Word入門”が見つかったら、その隣にある
 >>単価と備考のデータをコピーして貼り付けをしたいと思いました。
 >>そこで、下記のようなVBAを作ってみましたが、
 >>うまくいきませんでした。
 >>どの様に修正したら良いのかもわからず困っています。
 >>
 >>Sub kensaku()
 >>
 >>  Dim i As Integer
 >>  Dim cpyname As String
 >>
 >>  i = 1
 >>
 >>  Do Until Cells(i + 1, "A").Value = ""
 >  Do Until Cells(i, "A").Value = ""
 >>
 >>  If Cells(i, 1).Value = "Word入門" Then
 >>  Range(Cells(i, 2), Cells(i, 3)).Select
 >>  Selection.Copy
 >>  Range("E1").Activate
 >   ↑このままですと、Word入門が何個あろうが常にE1に貼り付けを行ってしまいますよ!
 >   Range("E" & i ).Activate とか?
 >>  ActiveCell.PasteSpecial
 >>
 >>  End If
 >>  i = i + 1
 >>  Loop
 >>
 >>End Sub
 >>
 >>ご存知の方、もしくは何かアドバイスをいただければ
 >>幸いです。
 >>何卒宜しくお願い致します。
 
 
 |  |